Re: DCL/LISP to insert block from list
#16Please post the file fredsingle2.dcl and ldct1.dim or ldct2.dim too.
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;
}
}
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")
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)
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")