Display posts from previous
Sort by

DCL/LISP to insert block from list

#1 by sln8458
Hi All,

First off, I am a complete novice at dcl/lsp.
I am trying to create a utility where I can insert a standard block by selecting it from a dcl dialogue list:
Image

I have managed to create the dcl dialogue ^^ and display the list. However I am now in trouble as I cannot transfer the selected file name into the 'insert' command

The list file is structured:
("LD75mm Straight Run 3mtr" filename)

Can anyone point me in the right direction please?

Re: DCL/LISP to insert block from list

#2 by QuanNguyen
Hi,

To insert the block from a file. first insert the block define from the file path then next insert the block name at the specified position.
Refer:

Code: Select all

(defun c:insBlock (/ blockName fileName insertPoint )
  (setq blockName "LD75mm Straight Run 3mtr"
	fileName "C:\\temp\\BlockDrawing.dwg")
  
  (if (not(tblsearch "layer" blockName)) ;; check if the drawing not existing the block name
    (progn
      (vl-cmdf "-insert" fileName "0.0,0.0,0.0" "" "" "") ;;inserts your master file from some defined file path
      (vl-cmdf "._erase" "l" "") 			  ;;erases the block; last inserted
      ))
  
  (if (setq insertPoint (getpoint "\npick point:"))
    (vl-cmdf "-insert" blockName  insertPoint "" "" "") ;;inserts the block you want from the master file
    )
  (princ)
  )

Re: DCL/LISP to insert block from list

#3 by sln8458
HI,

Thanks for the reply.

If I am reading your code correctly, I have to define the 'block name' in the lisp code?
(setq blockName "LD75mm Straight Run 3mtr"
fileName "C:\\temp\\BlockDrawing.dwg")
I have over 4,000 standard blocks, and I was hoping to avoid defining the block name in the lisp code.
(note: all blocks are in the defined in the search paths)

Is it possible to use a 'space delimited' txt file to store the file block description AND blockname:
("LD75mm Straight Run 3mtr" filename)
Where "LD75mm Straight Run 3mtr" is the block description
and filename, is the file/block name

So:

Code: Select all

      (setq
        SIZE_DIMS
         (read (read-line DIM_FILE))
        TEST
         (strcase (nth 0 SIZE_DIMS))		;;this is the block description in the list
      ) ;end setq
to read the file containing the list,
then something like:

Code: Select all

(defun
   LD1_SETDIM ()
  (setq
    D  (nth 1 SIZE_DIMS)		;;this is the blockname in the list file
  ) ;end setq
) ;End LD1_SETDIM
to read the blockname?

Re: DCL/LISP to insert block from list

#4 by QuanNguyen
Yes, you can replace the blockname and fileName with the value from the listBox in DCL.

Suppose the return of dialog is a list : ("LD100mm Straight Run 3mtr" filename)

(setq listBoxRetun (list "LD100mm Straight Run 3mtr" filename))

then the blockName and fileName can access as you wrote above.
(setq blockName (nth 0 listBoxRetun)
fileName (nth 1 listBoxRetun) )

Re: DCL/LISP to insert block from list

#6 by sln8458
Hi
So I've worked on this some more and made some progress.
I've set "ldct1" to inset a specific block that exists in the search path.
This works as expected.
I've tried to set "ldct2" to insert the block from the list, but get an error message that drawing "D" cannot be found!

Can you offer any pointers please?

Code: Select all

  (if (= NEWTILE "ldct1")
    (INSERT_BLOCK1)		;GOTO INSERT BLOCK 1
  ) ;_ end of if
  (if (= NEWTILE "ldct2")
    (SET_BLOCK2)		;GOTO SET BLOCK 2
  ) ;_ end of if
 ) ;end INSERT_BLOCK_VIEW
;-----------------------------------------------------------------------;
 (defun
   SET_BLOCK ()
  (setq
    D  (nth 1 SIZE_DIMS)
  ) ;end setq
 ) ;End SET_BLOCK
 (defun
   SET_BLOCK2 ()
  (setq
    D  (nth 1 SIZE_DIMS)
  ) ;end setq
  (INSERT_BLOCK2)		;GOTO INSERT BLOCK 2
 ) ;End SET_BLOCK2
  ;-----------------------------------------------------------------------;
(defun
   INSERT_BLOCK1 ()
  (command
	"._-insert" "nut_ac" pause 1 1 0
   ) ;_ end of command
) ;end INSERT_BLOCK1
(defun
   INSERT_BLOCK2 ()
  (command
	"._-insert" "D" pause 1 1 0
   ) ;_ end of command
) ;end INSERT_BLOCK2

Re: DCL/LISP to insert block from list

#8 by sln8458
HI,

Thanks for the help.
I have done as you suggested, however it still does not work, but there is progress I think.

(Note: I have added a second button to the DCL for ldct2, in the lsp file this inserts an existing block 'nut_ac.dwg')

Here is the code:

Code: Select all

(defun
   INSERT_BLOCK1 ()
  (command
	"._-insert" "nut_ac" pause 1 1 0	;INSERT BLOCK 1
   ) ;_ end of command
) ;end INSERT_BLOCK1
(defun
   INSERT_BLOCK2 ()
  (command
	"._-insert" D pause 1 1 0		;INSERT BLOCK 2
   ) ;_ end of command
) ;end INSERT_BLOCK2
Here is the command history from Intellicad:

Command:
Command:
Rendering support loaded.
Raster image support loaded.
Command;
Command: fredsingle2
<Select insert point>/Reference:
Command: ._-insert
? to list blocks in drawing/BROWSE/EXPLORE/<Block to insert>: nut_ac
Scale/X/Y/Z/Rotation/Multiple/<Insertion point for block>:
Corner/XYZ/X scale factor <1.000000>: 1
Y scale factor: < Equal to X scale (1.000000)>: 1
Rotation angle for block <0>: 0
Command:
Command: fredsingle2
<Select insert point>/Reference:
Command: '_PMTHIST


And here is the Intellicad command history with the code (command "._-insert" "D" pause 1 1 0 ;INSERT BLOCK 2

Code: Select all

Command: 
Command: 
Rendering support loaded.
Raster image support loaded.
Command: 
Command: fredsingle2
<Select insert point>/Reference: 
Command: ._-insert
? to list blocks in drawing/BROWSE/EXPLORE/<Block to insert>: nut_ac
Scale/X/Y/Z/Rotation/Multiple/<Insertion point for block>: 
Corner/XYZ/X scale factor <1.000000>: 1
Y scale factor:  < Equal to X scale (1.000000)>: 1
Rotation angle for block <0>: 0
Command: 
Command: fredsingle2
Command: ._-insert
? to list blocks in drawing/BROWSE/EXPLORE/<Block to insert> <nut_ac>: D
-- Could not find file D.DWG. --
Error: Function cancelled
Command: '_PMTHIST
S

Re: DCL/LISP to insert block from list

#10 by sln8458
QuanNguyen wrote: ↑
Mon Jun 29, 2020 2:46 am
 Please remove the double quotes at the D variable.

(princ D) ; print the content of D variable to the command line.
(command "._-insert" D pause 1 1 0 )

Code: Select all

(defun
   INSERT_BLOCK2 ()
  (princ D) ; print the content of D variable to the command line.
  (command
	"._-insert" D pause 1 1 0		;INSERT BLOCK 2
   ) ;_ end of command
Here is the command history with the above implemented:

Command:
Command:
Rendering support loaded.
Raster image support loaded.
Command:
Command: fredsingle2LD-200MM-TRAY-RUN-3000
<Select insert point>/Reference: LD-200MM-TRAY-RUN-3000
Command: '_PMTHIST

S

Re: DCL/LISP to insert block from list

#11 by QuanNguyen
Try this:

Code: Select all

(defun INSERT_BLOCK2 ()
  ;(princ D) ; print the content of D variable to the command line.
  (if (tblsearch "block" D)
    (progn
      (command "_.insert" D pause "" "" ""))
    (progn
      (setq dwg (strcat D ".dwg"))
      (if (setq fullPath (findfile dwg))
	(command "_.-insert" fullPath  pause "" "" "")
	(Princ (strcat "\nNot found drawing name <" dwg "> in support file search path.")) )) )
  (princ))

Re: DCL/LISP to insert block from list

#12 by sln8458
Hi
Thanks again for the help.

I added your code above, unfortunately it did not work.

Here is the command prompt history:

Command:
Command:
Rendering support loaded.
Raster image support loaded.
Command:
Command: fredsingle2
Command: '_PMTHIST


Also, I noticed differences here in bold.
Is there a significance to the _.insert and _.-insert?

(defun INSERT_BLOCK2 ()
;(princ D) ; print the content of D variable to the command line.
(if (tblsearch "block" D)
(progn
(command "_.insert" D pause "" "" ""))
(progn
(setq dwg (strcat D ".dwg"))
(if (setq fullPath (findfile dwg))
(command "_.-insert" fullPath pause "" "" "")
(Princ (strcat "\nNot found drawing name <" dwg "> in support file search path.")) )) )
(princ))



S

Re: DCL/LISP to insert block from list

#14 by sln8458
Your suggestion worked. The block LD-200MM-TRAY-RUN-3000 appeared on the cursor for select insertion point.

Command prompt history

Command:
Command:
Rendering support loaded.
Raster image support loaded.
Command:
Command: fredsingle2
Command:
C:FREDSINGLE2
Command: (setq D "LD-200MM-TRAY-RUN-3000")
"LD-200MM-TRAY-RUN-3000"
Command: (INSERT_BLOCK2)
Command: _.-insert
? to list blocks in drawing/BROWSE/EXPLORE/<Block to insert>: E:\CustomCad\menus\testing folder\LD-200MM-TRAY-RUN-3000.dwg
Scale/X/Y/Z/Rotation/Multiple/<Insertion point for block>: '_PMTHIST
Scale/X/Y/Z/Rotation/Multiple/<Insertion point for block>:
Corner/XYZ/X scale factor <1.000000>:
Y scale factor: < Equal to X scale (1.000000)>:
Rotation angle for block <0>:
Command: '_PMTHIST

Re: DCL/LISP to insert block from list

#15 by sln8458

Code: Select all

;fredsingle2-152  c/w 2-120.dcl 
; COMPANION FILES:
;	fredsingle2.LSP HAS A FEW COMPANION FILES THAT ARE REQUIRED TO BE IN THE SAME
;	DIRECTORY IN ORDER TO FUNCTION. THESE FILES ARE NAMED AS FOLLOWS:
;	fredsingle2.dcl
;	fredsingle2.lsp
;	FRED_about.lsp
;	ldct2.dim	
;	ldct1.dim	Light Duty Cable Tray (duplicate for additional tabs, 6off)
;
;
;
;	add comments re wisey steel & other help

(defun
   ERR (MSG)
  (if (or (/= MSG "Function cancelled")
  ; If an error (such as ESC) occurs
          (= MSG "quit / exit abort")
      ) ;_ end of or
    (princ)
    (princ (strcat "\nError: " MSG))
  ) ; while this command is active...
  (setvar "OSMODE" OS) ; Restore saved modes
  (setq *ERROR* OLDERR) ; Restore old *error* handler
  (princ)
) ;end ERR
  ;------------------------------MAIN PROGRAM----------------------------;
  ;----------------------------------------------------------------------;     
  ;----------------------------------------------------------------------;
  ;Read data file and parse "size string", nth 0, for display in
  ;list box as variable display_list. 
(defun
   READ_DIM_FILE (/ A AA)
  (SET_NIL)
  (setq A "")
  (DEFAULTS)  
  (OPEN_DIM_FILE)
  (while (/= A NIL)
    (setq A (read-line DIM_FILE))
    (if (/= A NIL)
      (progn
        (setq
          A  (nth 0 (read A))
          AA (append AA (list A))
        ) ;_ end of setq
      ) ;end progn
    ) ;end if
  ) ;end while
  (setq DISPLAY_LIST (reverse AA))
  (close DIM_FILE)
  (start_list "get_size")
  (mapcar 'add_list DISPLAY_LIST)
  (end_list)
) ;end READ_DIM_FILE
  ;-----------------------------------------------------------------------;
(defun
   SET_NIL ()
  (setq
    DEF_NEWTILE NIL
    DEF_SIZE NIL
    DEF_DISPLAY_LIST NIL
    DEF_INDEX NIL
    DEF_D NIL
    SIZE NIL
    DISPLAY_LIST NIL
    INDEX NIL
    D NIL
  ) ;_ end of setq
  (start_list "get_size")
  (mapcar 'add_list DISPLAY_LIST)
  (end_list)
) ;end SET_NIL
 ;-----------------------------------------------------------------------;
 ;-----------------------------------------------------------------------;
 ;-----------------------------------------------------------------------;
 ;-----------------------------------------------------------------------;
  ;Read selected dwg name (size, size,) from list box and read name list from
  ;data file.
(defun
   DIM_LIST (/ TEST)
  (OPEN_DIM_FILE)
  (progn
    (while (/= SIZE TEST)
      (setq
        SIZE_DIMS
         (read (read-line DIM_FILE))
        TEST
         (strcase (nth 0 SIZE_DIMS))
      ) ;end setq
    ) ;end while
    (close DIM_FILE)
  ) ;end progn
  (SET_DIM)
) ;end DIM_LIST
 ;-----------------------------------------------------------------------;
 ;-----------------------------------------------------------------------;
 ;-----------------------------------------------------------------------;
 ;-----------------------------------------------------------------------;
  ;Find and open data file, *.dim
(defun
   OPEN_DIM_FILE ()
  (if (= NEWTILE "ldct2")
    (setq DIM_FILE (open (findfile "ldct2.dim") "r"))
  ) ;_ end of if
  (if (= NEWTILE "ldct1")
    (setq DIM_FILE (open (findfile "ldct1.dim") "r"))
  ) ;_ end of if
 ) ;end OPEN_DIM_FILE
  ;-----------------------------------------------------------------------;
(defun
   SET_DIM ()
  (if (and (= NEWTILE "ldct2") (/= SIZE NIL))
    (SET_BLOCK)
  ) ;_ end of if
  (if (and (= NEWTILE "ldct1") (/= SIZE NIL))
    (SET_BLOCK2)
  ) ;_ end of if
 ) ;end SET_DIM
  ;-----------------------------------------------------------------------;
(defun
   DRAW_SHAPE ()
  (if (and (/= NEWTILE NIL))
    (INSERT_BLOCK_VIEW)
  ) ;_ end of if
 ) ; end DRAW_SHAPE
  ;-----------------------------------------------------------------------;
(defun
   INSERT_BLOCK_VIEW ()
  (initget 137 "R")
  (setq INSERT_PT (getpoint "\n<Select insert point>/Reference: "))
  (if (= INSERT_PT "R")
    (progn
      (setq BPT (getpoint "\nEnter BASE point: "))
      (setq RPT (getpoint "\nEnter x,y REFERENCE from BASE point: "))
      (setq
        INSERT_PT
         (list
           (+ (car BPT) (car RPT))
           (+ (cadr BPT) (cadr RPT))
         ) ;_ end of list
      ) ;_ end of setq
    ) ;end progn
  ) ;end if
  (setvar "OSMODE" 0)
  (if (= NEWTILE "ldct2")
    (INSERT_BLOCK1)		;GOTO INSERT BLOCK 1
  ) ;_ end of if
  (if (= NEWTILE "ldct1")
    (SET_BLOCK2)		;GOTO SET BLOCK 2
  ) ;_ end of if
 ) ;end INSERT_BLOCK_VIEW
;-----------------------------------------------------------------------;
 (defun
   SET_BLOCK ()
  (setq
    D  (nth 1 SIZE_DIMS)
  ) ;end setq
 ) ;End SET_BLOCK1	:was  ) ;End SET_BLOCK 
 (defun
   SET_BLOCK2 ()
  (setq
    D  (nth 1 SIZE_DIMS)
  ) ;end setq
  (INSERT_BLOCK2)		;GOTO INSERT BLOCK 2
 ) ;End SET_BLOCK2
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
(defun
   INSERT_BLOCK1 ()
  (command "._-insert" "LD-200MM-TRAY-RUN-3000" pause 1 1 0	;INSERT BLOCK 1
   ) ;_ end of command
) ;end INSERT_BLOCK1
  ;-----------------------------------------------------------------------;
;(defun
;   INSERT_BLOCK2 ()
;  (princ D) ; print the content of D variable to the command line.
;  (command "._-insert" D pause 1 1 0		;INSERT BLOCK 2
;   ) ;_ end of command
;) ;end INSERT_BLOCK2
  ;-----------------------------------------------------------------------;
(defun INSERT_BLOCK2 ()
  ;(princ D) ; print the content of D variable to the command line.
  (if (tblsearch "block" D)
    (progn
     (command "_.insert" D pause "" "" ""))
;     (command "._-insert" D pause "" "" ""))
    (progn
      (setq dwg (strcat D ".dwg"))
      (if (setq fullPath (findfile dwg))
	(command "_.-insert" fullPath  pause "" "" "")
	(Princ (strcat "\nNot found drawing name <" dwg "> in support file search path.")) )) )
  (princ))
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
  ;-----------------------------------------------------------------------;
(defun
   DEFAULTS () ;Set defaults
  (if (/= DEF_NEWTILE NIL)
    (setq NEWTILE DEF_NEWTILE)
  ) ;_ end of if
  (if (/= DEF_DISPLAY_LIST NIL)
    (progn
      (setq DISPLAY_LIST DEF_DISPLAY_LIST)
      (start_list "get_size")
      (mapcar 'add_list DISPLAY_LIST)
      (end_list)
    ) ;_ end of progn
  ) ;_ end of if
  (if (/= DEF_SIZE NIL)
    (setq SIZE DEF_SIZE)
  ) ;_ end of if
  (if (/= DEF_INDEX NIL)
    (setq INDEX DEF_INDEX)
  ) ;_ end of if
  (if (/= DEF_D NIL)
    (setq D DEF_D)
  ) ;_ end of if
) ;end DEFAULTS
  ;--------------------------------------------------------------------;
(defun
   CHECK_SELECTIONS () ;First save defaults
  (setq
    DEF_NEWTILE NEWTILE
    DEF_SIZE SIZE
    DEF_DISPLAY_LIST DISPLAY_LIST
    DEF_INDEX INDEX
    DEF_D D
  ) ;end setq
  ;Then check selections
  (if (= NEWTILE NIL)
    (alert "OOPS! SELECT A SHAPE TYPE - TRY AGAIN!")
  ) ;_ end of if
  (if (and (/= NEWTILE NIL) (= SIZE NIL))
    (alert "OOPS! SELECT A SHAPE SIZE - TRY AGAIN!")
  ) ;_ end of if
  (if (and (/= NEWTILE NIL) (/= SIZE NIL))
    (done_dialog)
  ) ;_ end of if
) ;end CHECK_SELECTIONS
  ;--------------------------------------------------------------------;
(defun
   DIALOG ()
  (setq DCL_ID (load_dialog "fredsingle2.dcl")) ;load the DCL file
  (if (not (new_dialog "fredsingle2" DCL_ID)) ;initialize the DCL file
    (exit) ;exit if this doesn't work
  ) ;end if
  (DEFAULTS)
  (action_tile
    "ldct2"
    (strcat
      "(setq newtile $key)"
      "(READ_DIM_FILE)"
    ) ;_ end of strcat
  ) ;_ end of action_tile
  (action_tile
    "ldct1"
    (strcat
      "(setq newtile $key)"
      "(READ_DIM_FILE)"
    ) ;_ end of strcat
  ) ;_ end of action_tile
  (action_tile
    "get_size"
    (strcat
      "(setq index (atoi $value))"
      "(setq size (strcase (nth index display_list)))"
      "(DIM_LIST)"
    ) ;_ end of strcat
  ) ;_ end of action_tile
  (action_tile "accept" "(CHECK_SELECTIONS)")
  (action_tile
    "cancel"
    (strcat "(done_dialog)" "(setq newtile nil size nil )" "(exit)")
  ) ;_ end of action_tile
  (action_tile "help" "(help)")
  (start_dialog) ;display the dialog box
  (unload_dialog DCL_ID) ;unload the DCL file
) ;end DIALOG

  ;--------------------------------------------------------------------;
  ;--------------------------------------------------------------------;
(defun
   C:fredsingle2 (/ NEWTILE SIZE DISPLAY_LIST INDEX D 
         DIM_FILE
         )
  (setq
    OLDERR *ERROR*
    *ERROR* ERR
  ) ;_ end of setq
  (setq OS (getvar "OSMODE"))
  (setvar "OSMODE" 111)
  (DIALOG)
  (DRAW_SHAPE)
  (setvar "OSMODE" OS)
  (setq *ERROR* OLDERR) ; Restore old *error* handler
  (princ)
) ;end 

  ;Print message once loaded.
(princ)

Latest Posts
Post Reply

Return to “AutoLisp/SDS”