Good morning everyone,
I am trying to create a lisp with a dialogue window (DCL), which would be capable of running different lisp commands and remembering/storing the last made command.
For this reason, I used as an example a part of the lisp's StripMtext v3 code and tried to adjust it in mine.
However, I did not manage to make it work, and I need your help.
Can someone help me to make the following lisp work correctly?
The truth is I really needed it.
I thank you in advance for your help and time.
(defun c:RLSP( /
;; functions
*error*
acceptbutton
clearallbutton
maindialog
selectallbutton
setup
;;stripmtext <- global sub function, see end of file
;;unformat <- global sub function, see end of file
;;;;
dclfile
dcl#
action
lsprun
;;;;;
;; variables:
dcl_id
dclfilemsg
dclfilename
dialogmsg
docobj
keylist
modcnt
off
on
save
settings
ss
stripmtextkey
tilemsg
versionmsg
)
;;; Local functions
(defun *error* (msg)
(vla-endundomark
(vlax-get-property
(vlax-get-acad-object)
"ActiveDocument"
)
)
(cond
((member msg
'("Function cancelled"
"quit / exit abort"
"console break"
)
)
)
((princ (strcat " Error: " msg)))
)
(princ)
)
(defun SelectAllButton ()
(foreach key keylist (set_tile key on))
(set_tile "error" "")
(mode_tile "accept" 2)
)
(defun ClearAllButton ()
(foreach key keylist (set_tile key off))
(set_tile "error" tilemsg)
)
(defun AcceptButton ()
;Build string to be passed later to the unformat function
;Strcat key character for each checkmarked key
(setq settings "")
(foreach key keylist
(if (= (get_tile key) on)
(setq settings (strcat settings key))
)
)
;If no keys are checkmarked, show error message
;Else if save is enabled, save settings to registry
(if (= settings "")
(set_tile "error" tilemsg)
(progn
(if (= (get_tile "save") on)
(progn
(vl-registry-write StripMtextKey "Settings" settings)
(vl-registry-write StripMtextKey "Save" on)
)
(vl-registry-write StripMtextKey "Save" off)
)
(if (= (strlen settings) (length keylist))
(setq settings "*")
)
);progn
)
)
(defun MainDialog ( / status done)
;Display checkbox default values and define checkbox callbacks
(set_tile "save" save)
(foreach key keylist
(if (vl-string-search key settings)(set_tile key on))
(action_tile key "(set_tile \"error\" \"\" )" )
)
;Define button callbacks
(action_tile "clearall" "(ClearAllButton)")
(action_tile "selectall" "(SelectAllButton)")
(action_tile "accept" "(AcceptButton)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq status (start_dialog))
(unload_dialog dcl_id)
;Return key used to close dialog
;If status = 0 , then Cancel button hit
;If status = 1 , then Accept button hit
status
)
(defun Setup ()
(setq
;--- Set Constants ---
;Toggles for dcl checkbox status
on "1"
off "0"
;Error messages
tilemsg "Select one or more settings or press \"Cancel\" to exit"
versionmsg "StripMtext error:\nRequires AutoCAD 2000 or higher"
dialogmsg "StripMtext error:\nUnable to load dialog"
dclfilemsg "StripMtext error:\nCannot load DCL file \"StripMtext[3].dcl\""
;DCL file
dclfilename "runlisp.DCL"
;List of dcl checkbox key names
;Must correspond with DCL keys and Unformat function
keylist '("ck1" "ck2" "ck3" "ck4")
;Registry path for storing user's settings
StripMtextkey "HKEY_CURRENT_USER\\SOFTWARE\\StripMtext\\"
;--- Set Defaults ---
;Get user's default settings from registry if exist
;If user has not saved default settings, use coded default
settings (cond
((vl-registry-read StripMtextKey "Settings"))
((vl-registry-write StripMtextKey "Settings" "CFH"))
)
save (cond
((vl-registry-read StripMtextKey "Save"))
((vl-registry-write StripMtextKey "Save" "1"))
)
);setq
)
;;;;;;;;;;;;;;;;
(Setup)
(cond
;Find dcl file
((< (setq dcl_id (load_dialog dclfilename)) 0)
; (alert dclfilemsg)
)
;Successful dcl load
((not (new_dialog "runlisp" dcl_id))
(alert dialogmsg)
)
;If user exits dcl using Accept button, process pickset
((= (MainDialog) 1)
;Process
; (setq modcnt (StripMtext ss settings))
;Display count of stripped objects
);cond
(princ)
);program
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_checks(/ result)
(if (= (get_tile "ck1") "1")
(setq result (cons "Unlock all layers" result))
)
(if (= (get_tile "ck2") "1")
(setq result (cons "Layer to Layer 0-OLD" result))
)
(if (= (get_tile "ck3") "1")
(setq result (cons "CBL_ColorByLayer" result))
)
(if (= (get_tile "ck4") "1")
(setq result (cons "Layer color 9" result))
)
result
)
;;================================================================
;; Start of Routine
;;================================================================
(setq dclfile "runlisp.dcl")
(cond
((< (setq dcl# (load_dialog dclfile)) 0) (prompt (strcat "\nCannot load " dclfile ".")))
((not (new_dialog "runlisp" dcl#)) (prompt (strcat "\nProblem with " dclfile ".")))
(t ; No DCL problems:
;; set actions
(action_tile "accept" ; DCL OK exit action
"(setq lsprun (get_checks)) (done_dialog 1)")
(setq action (start_dialog))
(unload_dialog dcl#)
(if (= action 1) ; OK was pressed
(progn
(print "OK was pressed")
;; do you scripr files here
;; lsprun = a list of checked items
(if (member "Unlock all layers" lsprun)
(C:LUA)
)
(if (member "Layer to Layer 0-OLD" lsprun)
(C:0T0)
)
(if (member "CBL_ColorByLayer" lsprun)
(C:CBL)
)
(if (member "Layer color 9" lsprun)
(C:LA9)
)
)
(print "User Quit.")
)
)
) ; end cond
)
(princ)
;(prompt "\nALL OK.")
(princ)
