Code Red > Visual DCL Programming
Classical way to use dialogs
Grrr1337:
Hi guys,
I just wanted to leave this classical template to load & display & get inputs from dialog.
The reason is because I didn't have enough experience about looking for the actual .dcl file, loading it and displaying it
I was always creating my dialogs on the fly, since Lee Mac has revealed his strategy/method - which is perfect BTW.
Another reason was because I'm always forgetting where the *_tile functions must be located - in this clear sample code the set/get/mode/action_tile
are between the new_dialog and start_dialog.
My memory fails and I'm confusing the load_dialog/new_dialog/start_dialog order, and between which ones I had to use the tile functions. :uglystupid2:
--- Code - Auto/Visual Lisp: ---; Learning the classical way to load and run dialogs - without creating them on the fly:(defun C:test ( / *error* dcp dcl dch dcf side len wid radius ) (defun *error* ( msg ) (and (< 0 dch) (unload_dialog dch)) ; Unloads the DCL file associated with dcl_id (obtained from a previous new_dialog call) from memory. Always return nil (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) )) (princ) ); defun *error* (cond ( (not (setq dcp (findfile "Rectangle.dcl"))) ; trusted path and filename with extension (princ "\nUnable to find the DCL file.") ) ( (progn (setq dcl (apply 'strcat (cdr (fnsplitl dcp)))) ; filename with extension, example: "Rectangle.dcl" (> 0 (setq dch (load_dialog dcl))) ; 1 ; Returns: A positive integer value (dcl_id) if successful, or a negative integer if load_dialog can't open the file. ; The dcl_id is used as a handle in subsequent new_dialog and unload_dialog calls. ); progn (princ "\nUnable to load the DCL file.") ) ( (not (new_dialog "rect" dch)) ; (new_dialog dlgname dcl_id [action [screen-pt]]) ; Display ; Returns: T, if successful, otherwise nil. (princ "\nUnable to display the dialog") ) ( (progn ; Set Default values for the tiles: (set_tile "CE" "1") ; rectangle justification centered - enable (set_tile "X" "300") ; length (set_tile "Y" "600") ; width (set_tile "FT" "0") ; fillet toggle - disable (set_tile "FR" "60") ; Fillet radius ; Set Default values for the lisp symbols - AFTER the default values for the tiles are set: (setq side "CE") (setq len (get_tile "X")) (setq wid (get_tile "Y")) (setq radius (get_tile "FR")) ; Set Default mode for the fillet tile: (mode_tile "FR" (if (= "1" (get_tile "FT")) 0 1)) ; check the toggle's value and enable/disable accordingly ; Set Default actions for the tiles: (action_tile "LS" "(setq side $key)") (action_tile "CE" "(setq side $key)") (action_tile "RS" "(setq side $key)") (action_tile "X" "(setq len $value)") (action_tile "Y" "(setq wid $value)") (action_tile "FR" "(setq radius $value)") (action_tile "FT" ; action for the fillet's toggle (vl-prin1-to-string '(cond ( (= "1" (get_tile "FT")) (mode_tile "FR" 0) ) ; Enabled ( (= "0" (get_tile "FT")) (mode_tile "FR" 1) ) ; Disabled ); cond ); vl-prin1-to-string ); action_tile "FT" (action_tile "accept" (vl-prin1-to-string '(cond ( (not (numberp (read len))) (set_tile "error" "Invalid Length value!") ) ( (not (numberp (read wid))) (set_tile "error" "Invalid Width value!") ) ( (and (= "1" (get_tile "FT")) (not (numberp (read radius)))) ; tile is enabled and not numerical (set_tile "error" "Invalid Radius value!") ) (T (if (= "0" (get_tile "FT")) (setq radius nil) ) ; set radius to nil if the fillet's toggle is disabled (done_dialog 1) ) ); cond ); vl-prin1-to-string ); action_tile "accept" (/= 1 (setq dcf (start_dialog))) ; Display the dialog and begin accepting the user inputs ); progn (princ "\nUser cancelled the dialog.") ) (T ; User finished with dialog, proceed with the inputs (alert (strcat "\nUser has chosen:" "\nSide: " side "\nLength: " len "\nWidth: " wid "\nRadius: " (if (eq 'STR (type radius)) radius "") ); strcat ); alert ) ); cond (*error* nil) (princ)); defun
DCL (Rectangle.dcl) :
--- Code: ---rect : dialog
{ label = "Draw a Rectangle";
: boxed_radio_row
{ label = "Select placement method";
: radio_button { key = "LS"; label = "Left Side"; }
: radio_button { key = "CE"; label = "Center"; }
: radio_button { key = "RS"; label = "Right Side"; }
}
: row
{ : boxed_column
{ label = "Size";
: edit_box { key = "X"; label = "Length"; edit_width = 6; }
: edit_box { key = "Y"; label = "Width"; edit_width = 6; }
}
: boxed_column
{ label = "Fillet";
: toggle { key = "FT"; label = "Fillet corners?"; }
: edit_box { key = "FR"; label = "Radius"; }
}
}
spacer; ok_cancel;
: text { label = ""; key = "error"; }
}
--- End code ---
I'll continue write from scratch some useless lisp codes that are using dialogs - so hopefully I'll memorize the methodology/technique.
Although one question appeared, how can I stack multiple dialogs? Maybe like this? :
--- Code - Auto/Visual Lisp: ---; Will this run and display 3 nested dialogs at once?(setq dch (load_dialog dcl_file_with_3_dialogs)) (new_dialog "dialog1" dch)(set_tile ...)(get_tile ...)(action_tile ...)(start_dialog) (new_dialog "dialog2" dch)(set_tile ...)(get_tile ...)(action_tile ...)(start_dialog) (new_dialog "dialog3" dch)(set_tile ...)(get_tile ...)(action_tile ...)(start_dialog)
And will such thing work? :
--- Code - Auto/Visual Lisp: ---; By pressing that button will it display the nested dialog?(action_tile "MoreOptions" (vl-prin1-to-string '(progn (new_dialog "dialog2" dch) (set_tile ...) (get_tile ...) (action_tile ...) (start_dialog) ) ))
roy_043:
Two remarks:
Why don't you use:
--- Code - Auto/Visual Lisp: ---(load_dialog dcp)
You have:
--- Code - Auto/Visual Lisp: ---(set_tile "X" "300")(setq len (get_tile "X"))I would use:
--- Code - Auto/Visual Lisp: ---(setq len "300")(set_tile "X" len)
Grrr1337:
--- Quote from: roy_043 on April 06, 2017, 03:05:34 AM ---Why don't you use:
--- Code - Auto/Visual Lisp: ---(load_dialog dcp)
--- End quote ---
Hmm.. I did not realise that load_dialog acts like findfile, so this first cond block is redundant:
--- Code - Auto/Visual Lisp: --- ( (not (setq dcp (findfile "Rectangle.dcl"))) ; trusted path and filename with extension (princ "\nUnable to find the DCL file."))I thought (without testing) that load_dialog might check the dcl file's content, and if theres invalid dialog it would return negative int.
--- Quote from: roy_043 on April 06, 2017, 03:05:34 AM ---You have:
--- Code - Auto/Visual Lisp: ---(set_tile "X" "300")(setq len (get_tile "X"))I would use:
--- Code - Auto/Visual Lisp: ---(setq len "300")(set_tile "X" len)
--- End quote ---
Technically both seem correct, but I think your suggestion is more "classical" (didn't thought about it, while writing this code).
Thanks for your input, Roy!
Two or more brains are better than one. :)
ribarm:
I was experimenting with DCL lisping recently...
I've come to this example - very easy way to implement DCL in normal form into main LSP file - the trick is that LSP file must read itself while running... That topic by @baitang36 forced me to search for ways of how to obtain path/filename from file that was loaded - here it's little differnt : we need to find path/filename of file (LSP/VLX/FAS/DES/...) that is currently running...
So I ended by integrating one starting INPUT more with (getfiled) function - so basically it's simple procedure [assuming that you are not going to put *.LSP in furthest branches from main root of HD...]
--- Code - Auto/Visual Lisp: ---;;;----------------------------------------------------------------------------;;;;;; ;;;;;; LSP file with DCL in normal form (master LSP = source for DCL) ;;;;;; ;;;;;;----------------------------------------------------------------------------;;;;;; Example written by Marko Ribar, d.i.a. (architect) : 22.02.2022. ;;;;;;----------------------------------------------------------------------------;;; ;| DCL filerect : dialog{ label = "Draw a Rectangle"; : boxed_radio_row { label = "Select placement method"; : radio_button { key = "LS"; label = "Left Side"; } : radio_button { key = "CE"; label = "Center"; } : radio_button { key = "RS"; label = "Right Side"; } } : row { : boxed_column { label = "Size"; : edit_box { key = "X"; label = "Length"; edit_width = 6; } : edit_box { key = "Y"; label = "Width"; edit_width = 6; } } : boxed_column { label = "Fillet"; : toggle { key = "FT"; label = "Fillet corners?"; } : edit_box { key = "FR"; label = "Radius"; } } } spacer; ok_cancel; : text { label = ""; key = "error"; }}|; DCL specification must be in this form at the top of main LSP file ;;; you should use paragraph comments to exclude it from loading and evaluating with [ ;| and |; ] like here in this example ;;; (defun stripsubs nil ;; String to List - Lee Mac;; Separates a string using a given delimiter;; str - [str] String to process;; del - [str] Delimiter by which to separate the string;; Returns: [lst] List of strings (defun LM:str->lst ( str del / len lst pos ) (setq len (1+ (strlen del))) (while (setq pos (vl-string-search del str)) (setq lst (cons (substr str 1 pos) lst) str (substr str (+ pos len)) ) ) (reverse (cons str lst))) (defun strip_dcl ( lspfile / nf sf filename ) (setq nf (open (setq filename (vl-filename-mktemp "Rectangle" (car (LM:str->lst (vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object)))) ";")) ".dcl")) "w")) ;;; PLEASE HERE YOU SHOULD PERHAPS SUPPLY SFSP PATH ;;; (vl-filename-mktemp "filename" "path without last \\" "extension (.dcl)") ;;; "filename" can be any string - just make it valid... ;;; (setq sf (open lspfile "r")) (while (/= (substr (setq l (read-line sf)) 1 2) "|;") (if (and (/= (substr l 1 1) ";") (/= l "")) (write-line l nf) ) ) (close sf) (close nf) filename) ) ;;; end (stripsubs) ; Learning the classical way to load and run dialogs - without creating them on the fly:(defun C:Rectng-DCL-test ( / *error* LM:str->lst strip_dcl lspfile dcp dcl dch dcf side len wid radius ) (defun *error* ( msg ) (and (< 0 dch) (unload_dialog dch)) ; Unloads the DCL file associated with dcl_id (obtained from a previous new_dialog call) from memory. Always return nil (and dcp (findfile dcp) (vl-file-delete dcp)) ;;; COMMENT THIS LINE IF YOU ARE UNABLE TO GET DIALOG BOX INITIALIZING - (load_dialog) FAILURE TO BE ABLE TO START "NOTEPAD++" TO EXAMINE DCL FILE... IN MOST OF SITUATIONS DCL IS GOOD, BUT (load_dialog) FAILS AS ACTUALLY FUNCTION CAN'T FIND FILE PATH AND IS NOT WITH ADEQUATE FILENAME SPECIFICATION, AND PERHAPS YOU SHOULD PUT TMP.DCL FILE NOT IN TMP FOLDER, BUT SUPPORT SPSF OF ACAD/BCAD ;;; (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) )) (princ) ); defun *error* ;;; INPUT ;;; (alert "\nFIND EXACT LOCATION OF THIS LISP FILE THAT IS RUNNING AND CLICK OPEN IN DIALOG BOX THAT IS TO BE OPENED...") (setq lspfile (getfiled "PLEASE, FIND EXACT LOCATION OF THIS LISP FILE THAT IS RUNNING..." "\\" "lsp" 16)) (stripsubs) ;;; loading subs for striping DCL from this LSP with DCL in normal form (LSP = source file of DCL) ;;; (cond ( (not (setq dcp (strip_dcl lspfile))) ; trusted path and filename with extension (princ "\nUnable to find the DCL file.") ) ( (progn (setq dcl (apply 'strcat (cdr (fnsplitl dcp)))) ; filename with extension, example: "Rectangle.dcl" (> 0 (setq dch (load_dialog dcl))) ; 1 ; Returns: A positive integer value (dcl_id) if successful, or a negative integer if load_dialog can't open the file. ; The dcl_id is used as a handle in subsequent new_dialog and unload_dialog calls. ); progn (princ "\nUnable to load the DCL file.") (startapp "Notepad++.exe" dcp) ) ( (not (new_dialog "rect" dch)) ; (new_dialog dlgname dcl_id [action [screen-pt]]) ; Display ; Returns: T, if successful, otherwise nil. (princ "\nUnable to display the dialog") ) ( (progn ; Set Default values for the tiles: (set_tile "CE" "1") ; rectangle justification centered - enable (set_tile "X" "300") ; length (set_tile "Y" "600") ; width (set_tile "FT" "0") ; fillet toggle - disable (set_tile "FR" "60") ; Fillet radius ; Set Default values for the lisp symbols - AFTER the default values for the tiles are set: (setq side "CE") (setq len (get_tile "X")) (setq wid (get_tile "Y")) (setq radius (get_tile "FR")) ; Set Default mode for the fillet tile: (mode_tile "FR" (if (= "1" (get_tile "FT")) 0 1)) ; check the toggle's value and enable/disable accordingly ; Set Default actions for the tiles: (action_tile "LS" "(setq side $key)") (action_tile "CE" "(setq side $key)") (action_tile "RS" "(setq side $key)") (action_tile "X" "(setq len $value)") (action_tile "Y" "(setq wid $value)") (action_tile "FR" "(setq radius $value)") (action_tile "FT" ; action for the fillet's toggle (vl-prin1-to-string '(cond ( (= "1" (get_tile "FT")) (mode_tile "FR" 0) ) ; Enabled ( (= "0" (get_tile "FT")) (mode_tile "FR" 1) ) ; Disabled ); cond ); vl-prin1-to-string ); action_tile "FT" (action_tile "accept" (vl-prin1-to-string '(cond ( (not (numberp (read len))) (set_tile "error" "Invalid Length value!") ) ( (not (numberp (read wid))) (set_tile "error" "Invalid Width value!") ) ( (and (= "1" (get_tile "FT")) (not (numberp (read radius)))) ; tile is enabled and not numerical (set_tile "error" "Invalid Radius value!") ) (T (if (= "0" (get_tile "FT")) (setq radius nil) ) ; set radius to nil if the fillet's toggle is disabled (done_dialog 1) ) ); cond ); vl-prin1-to-string ); action_tile "accept" (/= 1 (setq dcf (start_dialog))) ; Display the dialog and begin accepting the user inputs ); progn (princ "\nUser cancelled the dialog.") ) (T ; User finished with dialog, proceed with the inputs (alert (strcat "\nUser has chosen:" "\nSide: " side "\nLength: " len "\nWidth: " wid "\nRadius: " (if (eq 'STR (type radius)) radius "") ); strcat ); alert ) ); cond (*error* nil)); defun
So, you can test it...
I was sucessful...
Regards, M.R.
ribarm:
More examples of integrated normal DCL data into ordinary LSP files...
(Forgive me for I stole master codes - but they already available here on theswamp... I found them useful - so I implemented method shown previously if someone need it...)
--- Code - Auto/Visual Lisp: ---;;;----------------------------------------------------------------------------;;;;;; ;;;;;; LSP file with DCL in normal form (master LSP = source for DCL) ;;;;;; ;;;;;;----------------------------------------------------------------------------;;;;;; Example written by Marko Ribar, d.i.a. (architect) : 22.02.2022. ;;;;;;----------------------------------------------------------------------------;;; ;| DCL fileMyPropsTest :dialog {key="set-title"; width=93.3; height=21.875; :text {label="Thanks Michael Puckett!! @ www.theswamp.org";} :column {children_fixed_height=true; children_fixed_width=true; :list_box {label="List of properties to modify"; key="PropsListbox"; height=14.5; width=92; tabs=40;} :text {key="TextLabel"; width=90;} :edit_box {key="PropsEditbox"; edit_width=90;} } :row {children_fixed_height=true; children_fixed_width=true; :spacer {} :button {label="Pick point"; key="PickPt";} :button {label="Pick from list"; key="PickList";} :button {label="Apply"; key="accept"; allow_accept=true;} // is_default=true; :button {label="Done"; key="cancel"; is_cancel=true;} :spacer {} } }MyPropsList :dialog {label="Select item from list."; :list_box {key="PropsListbox2"; height=15; width=40;} :row { :spacer {} :button {label="Cancel"; key="cancel"; is_cancel=true;} :spacer {} }}|;;;; DCL specification must be in this form at the top of main LSP file ;;; you should use paragraph comments to exclude it from loading and evaluating with [ ;| and |; ] like here in this example ;;; NOTE : dcl must not have blank lines ;;; (defun stripsubs nil ;; String to List - Lee Mac;; Separates a string using a given delimiter;; str - [str] String to process;; del - [str] Delimiter by which to separate the string;; Returns: [lst] List of strings (defun LM:str->lst ( str del / len lst pos ) (setq len (1+ (strlen del))) (while (setq pos (vl-string-search del str)) (setq lst (cons (substr str 1 pos) lst) str (substr str (+ pos len)) ) ) (reverse (cons str lst))) (defun strip_dcl ( lspfile / nf sf filename ) (setq nf (open (setq filename (vl-filename-mktemp "XXXXX" (car (LM:str->lst (vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object)))) ";")) ".dcl")) "w")) ;;; PLEASE HERE YOU SHOULD PERHAPS SUPPLY SFSP PATH ;;; (vl-filename-mktemp "filename" "path without last \\" "extension (.dcl)") ;;; "filename" can be any string - just make it valid... ;;; (setq sf (open lspfile "r")) (while (/= (substr (setq l (read-line sf)) 1 2) "|;") (if (and (/= (substr l 1 1) ";") (/= l "")) (write-line l nf) ) ) (close sf) (close nf) filename) ) ;;; end (stripsubs) (defun GetVlaAtoms nil ; By: Michael Puckett (vl-remove-if-not (function (lambda ( symbol ) (wcmatch (vl-symbol-name symbol) "vla-*"))) (atoms-family 0) ));-----------------------------------------------------------------------------------------(defun GetVlaProperties ( atoms ) ; By: Michael Puckett (vl-sort (mapcar (function (lambda ( symbolname ) (substr symbolname 9))) (vl-remove-if-not (function (lambda ( symbolname ) (wcmatch symbolname "vla-get-*" ;; don't need 'put' ) ) ) (mapcar (function vl-symbol-name) atoms) ) ) (function <) ));-----------------------------------------------------------------------------------------(defun GetVlaMethods ( atoms ) ; By: Michael Puckett (vl-sort (mapcar (function (lambda ( symbolname ) (substr symbolname 5))) (vl-remove-if (function (lambda ( symbolname ) (wcmatch symbolname "vla-get-*,vla-put-*" ;; need 'put' ) ) ) (mapcar (function vl-symbol-name) atoms) ) ) (function <) ));----------------------------------------------------------------------------------------------(defun ApplyToObject ( / NewValue OldValue Prop ) (setq NewValue (get_tile "PropsEditbox")) (setq Prop (get_tile "TextLabel")) (setq OldValue (vlax-get tmpObj Prop)) (cond ( (= (type OldValue) 'REAL) (setq NewValue (distof NewValue 2)) ) ( (= (type OldValue) 'INT) (setq NewValue (atoi NewValue)) ) ( (= (type OldValue) 'LIST) (setq NewValue (read NewValue)) ) ) (if (and (vlax-property-available-p tmpObj Prop T) (/= (type (vlax-get tmpObj Prop)) 'VLA-OBJECT) (/= (get_tile "PropsEditbox") "*Error getting value!!") (not (equal NewValue OldValue 0.0001)) ) (set_tile "set-title" (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put (list tmpObj Prop NewValue))) (strcat ARCH#LOGO " : PROPS Get Properties" " : Could not update property \"" Prop "\"!!") (progn (start_list "PropsListbox" 3) (mapcar (function (lambda ( x ) (add_list (strcat x "\t" (vl-princ-to-string (if (vl-catch-all-error-p (setq tmpChk (vl-catch-all-apply 'vlax-get (list tmpObj x)))) (strcat ARCH#LOGO " : PROPS Get Properties" " : Error getting value!!") tmpChk ) ) ) ) ) ) PropList ) (end_list) (strcat ARCH#LOGO " : PROPS Get Properties" " : Updated property \"" Prop "\"") ) ) ) (progn (mode_tile "PropsEditbox" 1) (set_tile "set-title" (strcat ARCH#LOGO " : PROPS Get Properties" " : Not able to edit property.")) ) ));----------------------------------------------------------------------------------------------(defun ListboxSelection ( / tmpNum Prop ) (setq tmpNum (read (get_tile "PropsListbox"))) (setq Prop (nth tmpNum PropList)) (if (or (not (vlax-property-available-p tmpObj Prop T)) (= (type (vlax-get tmpObj Prop)) 'VLA-OBJECT) (= (get_tile "PropsEditbox") "*Error getting value!!") ) (mode_tile "PropsEditbox" 1) (mode_tile "PropsEditbox" 0) ) (set_tile "TextLabel" Prop) (set_tile "PropsEditbox" (vl-princ-to-string (vlax-get tmpObj Prop))) (cond ( (or (= (strcase Prop) "LAYER") (= (strcase Prop) "LINETYPE") (= (strcase Prop) "STYLENAME") (= (strcase Prop) "TEXTSTYLE") ) (mode_tile "PickPt" 1) (mode_tile "PickList" 0) ) ( (vl-string-search "POINT" (strcase Prop)) (mode_tile "PickPt" 0) (mode_tile "PickList" 1) ) ( t (mode_tile "PickPt" 1) (mode_tile "PickList" 1) ) ) (mode_tile "PropsEditbox" 2));----------------------------------------------------------------------------------------------(defun PickFromList ( dch / tmpList tmpValue Prop OldValue ) (setq Prop (get_tile "TextLabel")) (setq OldValue (get_tile "PropsEditbox")) (if (not (new_dialog "MyPropsList" dch "" '(-1 -1))) ;(not (new_dialog "MyPropsList" DiaLoad)) (exit) ) (cond ( (= (strcase Prop) "LAYER") (setq tmpList LayList) ) ( (= (strcase Prop) "LINETYPE") (setq tmpList LTList) ) ( (= (strcase Prop) "STYLENAME") (if ObjDim (setq tmpList DimList) (setq tmpList StyList) ) ) ( (= (strcase Prop) "TEXTSTYLE") (setq tmpList StyList) ) ) (start_list "PropsListbox2") (mapcar (function add_list) tmpList) (end_list) (action_tile "PropsListbox2" "(if (= $reason 1) (progn (setq tmpValue (nth (read (get_tile \"PropsListbox2\")) tmpList)) (done_dialog 1)))") (action_tile "cancel" "(progn (setq tmpValue OldValue) (done_dialog 0))") (if (start_dialog) tmpValue ));----------------------------------------------------------------------------------------------(defun DialogPortion ( dcl TextLabel Point / tmpProp ) (setq ARCH#LOGO " Tim Willey's") (if (minusp (setq dch (load_dialog dcl))) (exit) ) ;(setq DiaLoad (load_dialog "ARCH_GrabProperties.dcl")) (if (not (new_dialog "MyPropsTest" dch "" '(-1 -1))) ;(not (new_dialog "MyPropsTest" DiaLoad)) (exit) ) (set_tile "set-title" (strcat ARCH#LOGO " : PROPS Get Properties")) (mode_tile "PickPt" 1) (mode_tile "PickList" 1) (start_list "PropsListbox" 3) (mapcar (function (lambda ( x ) (add_list (strcat x "\t" (vl-princ-to-string (if (vl-catch-all-error-p (setq tmpChk (vl-catch-all-apply 'vlax-get (list tmpObj x)))) "*Error getting value!!" tmpChk ) ) ) ) ) ) PropList ) (end_list) (if TextLabel (set_tile "TextLabel" TextLabel) ;(set_tile "TextLabel" "") ) (if Point (set_tile "PropsEditbox" Point) ;(set_tile "PropsEditbox" "") ) (action_tile "PickPt" "(progn (setq tmpProp (get_tile \"TextLabel\")) (done_dialog 3))") (action_tile "PickList" "(set_tile \"PropsEditbox\" (PickFromList dch))") (action_tile "PropsListbox" "(if (= $reason 1) (ListboxSelection))") (action_tile "accept" "(ApplyToObject)") (action_tile "cancel" "(done_dialog 0)") (if (= (start_dialog) 3) (PickPoint dcl tmpProp) ));----------------------------------------------------------------------------------------------(defun PickPoint ( dcl tmpProp / tmpPt ) (setq tmpPt (getpoint (strcat "\n Select new \"" tmpProp "\": "))) (DialogPortion dcl tmpProp (vl-princ-to-string tmpPt)));---------------------------------------------------------------------------------------------- (defun c:PRPS ( / *error* _findfile LM:str->lst strip_dcl lspfile dcp dcl dch ActDoc LayList StyList LTList DimList Sel tmpObj PropList ColumnLng Columns Remander ListCnt ColumnCnt DiaFile Opened DiaLoad GetPointCnt BlkList PageTwo ObjDim ARCH#LOGO ) ;| Creates a dialog box with all the properties available per object selected. Ones that can't be edited are greyed out, but this show you what they are. With objects that have the property coordiantes, you have to enter them in the way they are shown. I'm trying to find a better way to do this, but until then. Objects that have points, have a pick button next to them, but that doesn't work right now, so you have to enter the new point value as a list. Thanks to Michael Puckett for the codes provided within the routine. Use at your own risk. Tested one A2k4. Change to suite your needs. I am not to be blamed for anything that happens to your computer if you use this routine, and neither is anyone else named in this routine. v1.0 Issued for use. 12/27/05 v2.0 Changed the layout. It no longers writes it own dialog box. It puts all the properties into one dialog box, and you can edit them form there. Weither you pick it from a list, or pick a point. I like the other format better, but this is the only way I could get it to work with being able to pick a point, and work with the length of all the dimension properties. Changed how you call it just incase people want to see the difference. 12/28/05|; (vl-load-com) (defun *error* ( m ) (and dch (< 0 dch) (unload_dialog dch)) ; Unloads the DCL file associated with dcl_id (obtained from a previous new_dialog call) from memory. Always return nil (and dcp (findfile dcp) (vl-file-delete dcp)) ;;; COMMENT THIS LINE IF YOU ARE UNABLE TO GET DIALOG BOX INITIALIZING - (load_dialog) FAILURE TO BE ABLE TO START "NOTEPAD++" TO EXAMINE DCL FILE... IN MOST OF SITUATIONS DCL IS GOOD, BUT (load_dialog) FAILS AS ACTUALLY FUNCTION CAN'T FIND FILE PATH AND IS NOT WITH ADEQUATE FILENAME SPECIFICATION, AND PERHAPS YOU SHOULD PUT TMP.DCL FILE NOT IN TMP FOLDER, BUT SUPPORT SPSF OF ACAD/BCAD ;;; (and m (prompt m)) (princ) ) (defun _findfile ( libraryrootprefix filenamepattern / subs processsubfolders folders r ) ;;; (_findfile "F:\\ACAD ADDONS-NEW\\" "profile*.lsp") (defun subs ( folder ) (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1))) ) (defun processsubfolders ( rootfolder / subfolders ) (setq subfolders (subs rootfolder)) (foreach sub subfolders (if (= (substr rootfolder (strlen rootfolder)) "\\") (setq r (cons (strcat rootfolder sub) (processsubfolders (strcat rootfolder sub)))) (setq r (cons (strcat rootfolder "\\" sub) (processsubfolders (strcat rootfolder "\\" sub)))) ) ) r ) (setq folders (append (list libraryrootprefix) (processsubfolders libraryrootprefix))) (vl-some (function (lambda ( y ) (if (and y (setq x (vl-some (function (lambda ( x ) (if (findfile (strcat y "\\" x)) x ) ) ) (vl-directory-files y filenamepattern 1) ) ) ) (strcat y "\\" x) ) ) ) folders ) ) (setq lspfile (_findfile "C:\\ACAD ADDONS-NEW\\" "PRPS.lsp")) (stripsubs) ;;; loading subs for striping DCL from this LSP with DCL in normal form (LSP = source file of DCL) ;;; (setq dcp (strip_dcl lspfile)) (setq dcl (apply (function strcat) (cdr (fnsplitl dcp)))) (if (not GlbVarPropertiesList) (setq GlbVarPropertiesList (GetVlaProperties (GetVlaAtoms))) ) (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (vla-StartUndoMark ActDoc) (vlax-for Lay (vla-get-Layers ActDoc) (if (not (vl-string-search "|" (vla-get-Name Lay))) (setq LayList (cons (vla-get-Name Lay) LayList)) ) ) (setq LayList (vl-sort LayList '<)) (vlax-for Sty (vla-get-TextStyles ActDoc) (if (not (vl-string-search "|" (vla-get-Name Sty))) (setq StyList (cons (vla-get-Name Sty) StyList)) ) ) (setq StyList (vl-sort StyList '<)) (vlax-for LT (vla-get-LineTypes ActDoc) (if (not (vl-string-search "|" (vla-get-Name LT))) (setq LTList (cons (vla-get-Name LT) LTList)) ) ) (setq LTList (vl-sort LTList '<)) (vlax-for Dims (vla-get-DimStyles ActDoc) (if (not (vl-string-search "|" (vla-get-Name Dims))) (setq DimList (cons (vla-get-Name Dims) DimList)) ) ) (setq DimList (vl-sort DimList '<)) (vlax-for Blk (vla-get-Blocks ActDoc) (if (not (vl-string-search "|" (vla-get-Name Blk))) (setq BlkList (cons (vla-get-Name Blk) BlkList)) ) ) (setq BlkList (vl-sort BlkList '<)) (if (and (not (initget "Nested")) (setq Sel (entsel "\n* Select object to edit properties [or Nested to selected nested object]: ")) (if (= Sel "Nested") (setq Sel (nentsel "\n* Select nested object: ")) Sel ) ) (progn (if (= (cdr (assoc 0 (entget (car Sel)))) "DIMENSION") (setq ObjDim T) ) (setq tmpObj (vlax-ename->vla-object (car Sel))) (setq PropList (vl-remove-if-not (function (lambda ( x ) (vlax-property-available-p tmpObj x))) GlbVarPropertiesList)) (setq PropList (vl-sort PropList (function (lambda ( a b ) (< (strcase a) (strcase b)))))) (DialogPortion dcl nil nil) ) ) (vla-Regen ActDoc acActiveViewport) (vla-EndUndoMark ActDoc) (*error* nil))
Navigation
[0] Message Index
[#] Next page
Go to full version