Re: DCL/LISP to insert block from list

#17
DCL

Code: Select all

// fredsingle2-120
// Revision: 
//   25 Oct  2019 - SLN

fredsingle2 : dialog {
	label = "Steve's Cable Tray menu - fredsingle2";
	: text {
	  label = "Revision A : October 2019 : ";
	}

	: row {
		children_alignment = top;
		:column {
		: boxed_column {
			label = "Light Duty Cable Tray";
			: button {
			key = "ldct1";
			label = "Straight Tray Runs";
			}
			: button {
			key = "ldct2";
			label = "Straight Tray Runs 2";
			}
			}
                	}

		:column {
			: list_box {
			label = "Width Sizes (mm)";
			width = 25;
			height = 10;
			key = "get_size";
			}
			}
			}

	:row {
		fixed_width = true;
		alignment = centered;
		ok_cancel;
		}
	}

ldct1.dim (simple notepad txt file)

Code: Select all

("LD-900mm    Straight Run  3mtr" LD-900mm-tray-run-3000)
("LD-750mm    Straight Run  3mtr" LD-750mm-tray-run-3000)
("LD-600mm    Straight Run  3mtr" LD-600mm-tray-run-3000)
("LD-450mm    Straight Run  3mtr" LD-450mm-tray-run-3000)
("LD-300mm    Straight Run  3mtr" LD-300mm-tray-run-3000)
("LD-225mm    Straight Run  3mtr" LD-225mm-tray-run-3000)
("LD-200mm    Straight Run  3mtr" LD-200mm-tray-run-3000)
("LD-150mm    Straight Run  3mtr" LD-150mm-tray-run-3000)
("LD-100mm    Straight Run  3mtr" nut_af)
("LD-75mm     Straight Run  3mtr" nut_ac)
(" ")
("FREDSINGLE2")

Re: DCL/LISP to insert block from list

#18
Hi Steve,
Please use this one, it does not optimal but works well.

The Lisp:

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.
  (if (tblsearch "block" D)
    (progn
     (command "_.insert" D INSERT_PT "" "" ""))
;     (command "._-insert" D pause "" "" ""))
    (progn
      (setq dwg (strcat D ".dwg"))
      (if (setq fullPath (findfile dwg))
	(command "_.-insert" fullPath  INSERT_PT "" "" "")
	(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)
The Dim file, change file format, adding the double quotes at the block name) :

Code: Select all

("LD-900mm    Straight Run  3mtr" "LD-900mm-tray-run-3000")
("LD-750mm    Straight Run  3mtr" "LD-750mm-tray-run-3000")
("LD-600mm    Straight Run  3mtr" "LD-600mm-tray-run-3000")
("LD-450mm    Straight Run  3mtr" "LD-450mm-tray-run-3000")
("LD-300mm    Straight Run  3mtr" "LD-300mm-tray-run-3000")
("LD-225mm    Straight Run  3mtr" "LD-225mm-tray-run-3000")
("LD-200mm    Straight Run  3mtr" "LD-200mm-tray-run-3000")
("LD-150mm    Straight Run  3mtr" "LD-150mm-tray-run-3000")
("LD-100mm    Straight Run  3mtr" "nut_af")
("LD-75mm     Straight Run  3mtr" "nut_ac")
(" ")
("FREDSINGLE2")

Re: DCL/LISP to insert block from list

#20
Many thanks it works:)

The only change to the lsp file I can find is here
;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) 1st change by QuanNguyen
) ;end DIM_LIST

Plus the change to the txt file