Author Topic: Classical way to use dialogs  (Read 5182 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 783
Classical way to use dialogs
« on: April 05, 2017, 01:33:16 PM »
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: [Select]
  1. ; Learning the classical way to load and run dialogs - without creating them on the fly:
  2. (defun C:test ( / *error* dcp dcl dch dcf side len wid radius )
  3.  
  4.   (defun *error* ( msg )
  5.     (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
  6.     (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
  7.     (princ)
  8.   ); defun *error*
  9.  
  10.   (cond
  11.     ( (not (setq dcp (findfile "Rectangle.dcl"))) ; trusted path and filename with extension
  12.       (princ "\nUnable to find the DCL file.")
  13.     )
  14.     (
  15.       (progn
  16.         (setq dcl (apply 'strcat (cdr (fnsplitl dcp)))) ; filename with extension, example: "Rectangle.dcl"
  17.         (> 0 (setq dch (load_dialog dcl))) ; 1
  18.                                            ; Returns: A positive integer value (dcl_id) if successful, or a negative integer if load_dialog can't open the file.
  19.                                            ; The dcl_id is used as a handle in subsequent new_dialog and unload_dialog calls.
  20.       ); progn
  21.       (princ "\nUnable to load the DCL file.")
  22.     )
  23.     ( (not (new_dialog "rect" dch)) ; (new_dialog dlgname dcl_id [action [screen-pt]]) ; Display ; Returns: T, if successful, otherwise nil.
  24.       (princ "\nUnable to display the dialog")
  25.     )
  26.     (
  27.       (progn
  28.         ; Set Default values for the tiles:
  29.         (set_tile "CE" "1") ; rectangle justification centered - enable
  30.         (set_tile "X" "300") ; length
  31.         (set_tile "Y" "600") ; width
  32.         (set_tile "FT" "0") ; fillet toggle - disable
  33.         (set_tile "FR" "60") ; Fillet radius
  34.         ; Set Default values for the lisp symbols - AFTER the default values for the tiles are set:
  35.         (setq side "CE")
  36.         (setq len (get_tile "X"))
  37.         (setq wid (get_tile "Y"))
  38.         (setq radius (get_tile "FR"))
  39.         ; Set Default mode for the fillet tile:
  40.         (mode_tile "FR" (if (= "1" (get_tile "FT")) 0 1)) ; check the toggle's value and enable/disable accordingly
  41.         ; Set Default actions for the tiles:
  42.         (action_tile "LS" "(setq side $key)")
  43.         (action_tile "CE" "(setq side $key)")
  44.         (action_tile "RS" "(setq side $key)")
  45.         (action_tile "X" "(setq len $value)")
  46.         (action_tile "Y" "(setq wid $value)")
  47.         (action_tile "FR" "(setq radius $value)")
  48.         (action_tile "FT" ; action for the fillet's toggle
  49.           (vl-prin1-to-string
  50.             '(cond
  51.               ( (= "1" (get_tile "FT")) (mode_tile "FR" 0) ) ; Enabled
  52.               ( (= "0" (get_tile "FT")) (mode_tile "FR" 1) ) ; Disabled
  53.             ); cond
  54.           ); vl-prin1-to-string
  55.         ); action_tile "FT"
  56.         (action_tile "accept"
  57.           (vl-prin1-to-string
  58.             '(cond
  59.               ( (not (numberp (read len))) (set_tile "error" "Invalid Length value!") )
  60.               ( (not (numberp (read wid))) (set_tile "error" "Invalid Width value!") )
  61.               ( (and (= "1" (get_tile "FT")) (not (numberp (read radius)))) ; tile is enabled and not numerical
  62.                 (set_tile "error" "Invalid Radius value!")
  63.               )
  64.               (T
  65.                 (if (= "0" (get_tile "FT")) (setq radius nil) ) ; set radius to nil if the fillet's toggle is disabled
  66.                 (done_dialog 1)
  67.               )
  68.             ); cond
  69.           ); vl-prin1-to-string
  70.         ); action_tile "accept"
  71.         (/= 1 (setq dcf (start_dialog))) ; Display the dialog and begin accepting the user inputs
  72.       ); progn
  73.       (princ "\nUser cancelled the dialog.")
  74.     )
  75.     (T ; User finished with dialog, proceed with the inputs
  76.       (alert
  77.         (strcat
  78.           "\nUser has chosen:"
  79.           "\nSide: " side
  80.           "\nLength: " len
  81.           "\nWidth: " wid
  82.           "\nRadius: " (if (eq 'STR (type radius)) radius "")
  83.         ); strcat
  84.       ); alert
  85.     )
  86.   ); cond
  87.   (*error* nil) (princ)
  88. ); defun


DCL (Rectangle.dcl) :
Code: [Select]
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"; }
}

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: [Select]
  1. ; Will this run and display 3 nested dialogs at once?
  2. (setq dch (load_dialog dcl_file_with_3_dialogs))
  3.  
  4. (new_dialog "dialog1" dch)
  5. (set_tile ...)
  6. (get_tile ...)
  7.  
  8. (new_dialog "dialog2" dch)
  9. (set_tile ...)
  10. (get_tile ...)
  11.  
  12. (new_dialog "dialog3" dch)
  13. (set_tile ...)
  14. (get_tile ...)

And will such thing work? :
Code - Auto/Visual Lisp: [Select]
  1. ; By pressing that button will it display the nested dialog?
  2. (action_tile "MoreOptions"
  3.     '(progn
  4.       (new_dialog "dialog2" dch)
  5.       (set_tile ...)
  6.       (get_tile ...)
  7.       (action_tile ...)
  8.       (start_dialog)
  9.     )
  10.   )
  11. )
  12.  
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

roy_043

  • Water Moccasin
  • Posts: 1893
  • BricsCAD 18
Re: Classical way to use dialogs
« Reply #1 on: April 06, 2017, 03:05:34 AM »
Two remarks:

Why don't you use:
Code - Auto/Visual Lisp: [Select]

You have:
Code - Auto/Visual Lisp: [Select]
  1. (set_tile "X" "300")
  2. (setq len (get_tile "X"))
I would use:
Code - Auto/Visual Lisp: [Select]
  1. (setq len "300")
  2. (set_tile "X" len)

Grrr1337

  • Swamp Rat
  • Posts: 783
Re: Classical way to use dialogs
« Reply #2 on: April 06, 2017, 08:03:36 AM »
Why don't you use:
Code - Auto/Visual Lisp: [Select]

Hmm.. I did not realise that load_dialog acts like findfile, so this first cond block is redundant:
Code - Auto/Visual Lisp: [Select]
  1.    ( (not (setq dcp (findfile "Rectangle.dcl"))) ; trusted path and filename with extension
  2.       (princ "\nUnable to find the DCL file.")
  3. )
I thought (without testing) that load_dialog might check the dcl file's content, and if theres invalid dialog it would return negative int.

You have:
Code - Auto/Visual Lisp: [Select]
  1. (set_tile "X" "300")
  2. (setq len (get_tile "X"))
I would use:
Code - Auto/Visual Lisp: [Select]
  1. (setq len "300")
  2. (set_tile "X" len)

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. :)
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

ribarm

  • Gator
  • Posts: 2701
  • Marko Ribar, architect
Re: Classical way to use dialogs
« Reply #3 on: February 22, 2022, 02:15:32 PM »
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: [Select]
  1. ;;;----------------------------------------------------------------------------;;;
  2. ;;;                                                                            ;;;
  3. ;;;       LSP file with DCL in normal form (master LSP = source for DCL)       ;;;
  4. ;;;                                                                            ;;;
  5. ;;;----------------------------------------------------------------------------;;;
  6. ;;;  Example written by Marko Ribar, d.i.a. (architect) : 22.02.2022.          ;;;
  7. ;;;----------------------------------------------------------------------------;;;
  8.  
  9. ;| DCL file
  10. rect : dialog
  11. { label = "Draw a Rectangle";
  12.   : boxed_radio_row
  13.   { label = "Select placement method";
  14.     : radio_button { key = "LS"; label = "Left Side"; }
  15.     : radio_button { key = "CE"; label = "Center"; }
  16.     : radio_button { key = "RS"; label = "Right Side"; }
  17.   }
  18.   : row
  19.   { : boxed_column
  20.     { label = "Size";
  21.       : edit_box { key = "X"; label = "Length"; edit_width = 6; }
  22.       : edit_box { key = "Y"; label = "Width"; edit_width = 6; }
  23.     }
  24.     : boxed_column
  25.     { label = "Fillet";
  26.       : toggle { key = "FT"; label = "Fillet corners?"; }
  27.       : edit_box { key = "FR"; label = "Radius"; }
  28.     }
  29.   }
  30.   spacer; ok_cancel;
  31.   : text { label = ""; key = "error"; }
  32. }
  33. |; 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 ;;;
  34.  
  35.  
  36. (defun stripsubs nil
  37.  
  38. ;; String to List  -  Lee Mac
  39. ;; Separates a string using a given delimiter
  40. ;; str - [str] String to process
  41. ;; del - [str] Delimiter by which to separate the string
  42. ;; Returns: [lst] List of strings
  43.  
  44. (defun LM:str->lst ( str del / len lst pos )
  45.   (setq len (1+ (strlen del)))
  46.   (while (setq pos (vl-string-search del str))
  47.     (setq lst (cons (substr str 1 pos) lst)
  48.           str (substr str (+ pos len))
  49.     )
  50.   )
  51.   (reverse (cons str lst))
  52. )
  53.  
  54. (defun strip_dcl ( lspfile / nf sf filename )
  55.   (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... ;;;
  56.   (setq sf (open lspfile "r"))
  57.   (while (/= (substr (setq l (read-line sf)) 1 2) "|;")
  58.     (if (and (/= (substr l 1 1) ";") (/= l ""))
  59.       (write-line l nf)
  60.     )
  61.   )
  62.   (close sf)
  63.   (close nf)
  64.   filename
  65. )
  66.  
  67. ) ;;; end (stripsubs)
  68.  
  69. ; Learning the classical way to load and run dialogs - without creating them on the fly:
  70. (defun C:Rectng-DCL-test ( / *error* LM:str->lst strip_dcl lspfile dcp dcl dch dcf side len wid radius )
  71.  
  72.   (defun *error* ( msg )
  73.     (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
  74.     (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 ;;;
  75.     (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
  76.     (princ)
  77.   ); defun *error*
  78.  
  79.   ;;; INPUT ;;;
  80.  
  81.   (alert "\nFIND EXACT LOCATION OF THIS LISP FILE THAT IS RUNNING AND CLICK OPEN IN DIALOG BOX THAT IS TO BE OPENED...")
  82.   (setq lspfile (getfiled "PLEASE, FIND EXACT LOCATION OF THIS LISP FILE THAT IS RUNNING..." "\\" "lsp" 16))
  83.  
  84.   (stripsubs) ;;; loading subs for striping DCL from this LSP with DCL in normal form (LSP = source file of DCL) ;;;
  85.   (cond
  86.     ( (not (setq dcp (strip_dcl lspfile))) ; trusted path and filename with extension
  87.       (princ "\nUnable to find the DCL file.")
  88.     )
  89.     (
  90.       (progn
  91.         (setq dcl (apply 'strcat (cdr (fnsplitl dcp)))) ; filename with extension, example: "Rectangle.dcl"
  92.         (> 0 (setq dch (load_dialog dcl))) ; 1
  93.                                            ; Returns: A positive integer value (dcl_id) if successful, or a negative integer if load_dialog can't open the file.
  94.                                            ; The dcl_id is used as a handle in subsequent new_dialog and unload_dialog calls.
  95.       ); progn
  96.       (princ "\nUnable to load the DCL file.")
  97.       (startapp "Notepad++.exe" dcp)
  98.     )
  99.     ( (not (new_dialog "rect" dch)) ; (new_dialog dlgname dcl_id [action [screen-pt]]) ; Display ; Returns: T, if successful, otherwise nil.
  100.       (princ "\nUnable to display the dialog")
  101.     )
  102.     (
  103.       (progn
  104.         ; Set Default values for the tiles:
  105.         (set_tile "CE" "1") ; rectangle justification centered - enable
  106.         (set_tile "X" "300") ; length
  107.         (set_tile "Y" "600") ; width
  108.         (set_tile "FT" "0") ; fillet toggle - disable
  109.         (set_tile "FR" "60") ; Fillet radius
  110.         ; Set Default values for the lisp symbols - AFTER the default values for the tiles are set:
  111.         (setq side "CE")
  112.         (setq len (get_tile "X"))
  113.         (setq wid (get_tile "Y"))
  114.         (setq radius (get_tile "FR"))
  115.         ; Set Default mode for the fillet tile:
  116.         (mode_tile "FR" (if (= "1" (get_tile "FT")) 0 1)) ; check the toggle's value and enable/disable accordingly
  117.         ; Set Default actions for the tiles:
  118.         (action_tile "LS" "(setq side $key)")
  119.         (action_tile "CE" "(setq side $key)")
  120.         (action_tile "RS" "(setq side $key)")
  121.         (action_tile "X" "(setq len $value)")
  122.         (action_tile "Y" "(setq wid $value)")
  123.         (action_tile "FR" "(setq radius $value)")
  124.         (action_tile "FT" ; action for the fillet's toggle
  125.           (vl-prin1-to-string
  126.             '(cond
  127.               ( (= "1" (get_tile "FT")) (mode_tile "FR" 0) ) ; Enabled
  128.               ( (= "0" (get_tile "FT")) (mode_tile "FR" 1) ) ; Disabled
  129.             ); cond
  130.           ); vl-prin1-to-string
  131.         ); action_tile "FT"
  132.         (action_tile "accept"
  133.           (vl-prin1-to-string
  134.             '(cond
  135.               ( (not (numberp (read len))) (set_tile "error" "Invalid Length value!") )
  136.               ( (not (numberp (read wid))) (set_tile "error" "Invalid Width value!") )
  137.               ( (and (= "1" (get_tile "FT")) (not (numberp (read radius)))) ; tile is enabled and not numerical
  138.                 (set_tile "error" "Invalid Radius value!")
  139.               )
  140.               (T
  141.                 (if (= "0" (get_tile "FT")) (setq radius nil) ) ; set radius to nil if the fillet's toggle is disabled
  142.                 (done_dialog 1)
  143.               )
  144.             ); cond
  145.           ); vl-prin1-to-string
  146.         ); action_tile "accept"
  147.         (/= 1 (setq dcf (start_dialog))) ; Display the dialog and begin accepting the user inputs
  148.       ); progn
  149.       (princ "\nUser cancelled the dialog.")
  150.     )
  151.     (T ; User finished with dialog, proceed with the inputs
  152.       (alert
  153.         (strcat
  154.           "\nUser has chosen:"
  155.           "\nSide: " side
  156.           "\nLength: " len
  157.           "\nWidth: " wid
  158.           "\nRadius: " (if (eq 'STR (type radius)) radius "")
  159.         ); strcat
  160.       ); alert
  161.     )
  162.   ); cond
  163.   (*error* nil)
  164. ); defun
  165.  

So, you can test it...
I was sucessful...

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 2701
  • Marko Ribar, architect
Re: Classical way to use dialogs
« Reply #4 on: March 26, 2022, 11:19:53 AM »
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: [Select]
  1. ;;;----------------------------------------------------------------------------;;;
  2. ;;;                                                                            ;;;
  3. ;;;       LSP file with DCL in normal form (master LSP = source for DCL)       ;;;
  4. ;;;                                                                            ;;;
  5. ;;;----------------------------------------------------------------------------;;;
  6. ;;;  Example written by Marko Ribar, d.i.a. (architect) : 22.02.2022.          ;;;
  7. ;;;----------------------------------------------------------------------------;;;
  8.  
  9. ;| DCL file
  10. MyPropsTest :dialog {key="set-title"; width=93.3; height=21.875;
  11.     :text {label="Thanks Michael Puckett!!  @  www.theswamp.org";}
  12.     :column {children_fixed_height=true; children_fixed_width=true;
  13.       :list_box {label="List of properties to modify"; key="PropsListbox"; height=14.5; width=92; tabs=40;}
  14.       :text {key="TextLabel"; width=90;}
  15.       :edit_box {key="PropsEditbox"; edit_width=90;}    
  16.     }    
  17.     :row {children_fixed_height=true; children_fixed_width=true;
  18.       :spacer {}
  19.       :button {label="Pick point"; key="PickPt";}
  20.       :button {label="Pick from list"; key="PickList";}
  21.       :button {label="Apply"; key="accept"; allow_accept=true;} // is_default=true;
  22.       :button {label="Done"; key="cancel"; is_cancel=true;}
  23.       :spacer {}
  24.     }
  25.   }
  26. MyPropsList :dialog {label="Select item from list.";
  27.   :list_box {key="PropsListbox2"; height=15; width=40;}
  28.   :row {
  29.     :spacer {}
  30.     :button {label="Cancel"; key="cancel"; is_cancel=true;}
  31.     :spacer {}
  32.   }
  33. }
  34. |;
  35. ;;; 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 ;;;
  36.  
  37. (defun stripsubs nil
  38.  
  39. ;; String to List  -  Lee Mac
  40. ;; Separates a string using a given delimiter
  41. ;; str - [str] String to process
  42. ;; del - [str] Delimiter by which to separate the string
  43. ;; Returns: [lst] List of strings
  44.  
  45. (defun LM:str->lst ( str del / len lst pos )
  46.   (setq len (1+ (strlen del)))
  47.   (while (setq pos (vl-string-search del str))
  48.     (setq lst (cons (substr str 1 pos) lst)
  49.           str (substr str (+ pos len))
  50.     )
  51.   )
  52.   (reverse (cons str lst))
  53. )
  54.  
  55. (defun strip_dcl ( lspfile / nf sf filename )
  56.   (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... ;;;
  57.   (setq sf (open lspfile "r"))
  58.   (while (/= (substr (setq l (read-line sf)) 1 2) "|;")
  59.     (if (and (/= (substr l 1 1) ";") (/= l ""))
  60.       (write-line l nf)
  61.     )
  62.   )
  63.   (close sf)
  64.   (close nf)
  65.   filename
  66. )
  67.  
  68. ) ;;; end (stripsubs)
  69.  
  70. (defun GetVlaAtoms nil ; By: Michael Puckett
  71.   (vl-remove-if-not
  72.     (function (lambda ( symbol ) (wcmatch (vl-symbol-name symbol) "vla-*")))
  73.     (atoms-family 0)
  74.   )
  75. )
  76. ;-----------------------------------------------------------------------------------------
  77. (defun GetVlaProperties ( atoms ) ; By: Michael Puckett
  78.     (mapcar (function (lambda ( symbolname ) (substr symbolname 9)))
  79.       (vl-remove-if-not
  80.         (function
  81.           (lambda ( symbolname )
  82.             (wcmatch
  83.               symbolname
  84.               "vla-get-*"
  85.               ;; don't need 'put'
  86.             )
  87.           )
  88.         )
  89.         (mapcar (function vl-symbol-name) atoms)
  90.       )
  91.     )
  92.     (function <)
  93.   )
  94. )
  95. ;-----------------------------------------------------------------------------------------
  96. (defun GetVlaMethods ( atoms ) ; By: Michael Puckett
  97.     (mapcar (function (lambda ( symbolname ) (substr symbolname 5)))
  98.       (vl-remove-if
  99.         (function
  100.           (lambda ( symbolname )
  101.             (wcmatch
  102.               symbolname
  103.               "vla-get-*,vla-put-*"
  104.               ;; need 'put'
  105.             )
  106.           )
  107.         )
  108.         (mapcar (function vl-symbol-name) atoms)
  109.       )
  110.     )
  111.     (function <)
  112.   )
  113. )
  114. ;----------------------------------------------------------------------------------------------
  115. (defun ApplyToObject ( / NewValue OldValue Prop )
  116.   (setq NewValue (get_tile "PropsEditbox"))
  117.   (setq Prop (get_tile "TextLabel"))
  118.   (setq OldValue (vlax-get tmpObj Prop))
  119.   (cond ( (= (type OldValue) 'REAL) (setq NewValue (distof NewValue 2)) )
  120.         ( (= (type OldValue) 'INT) (setq NewValue (atoi NewValue)) )
  121.         ( (= (type OldValue) 'LIST) (setq NewValue (read NewValue)) )
  122.   )
  123.   (if
  124.     (and
  125.       (vlax-property-available-p tmpObj Prop T)
  126.       (/= (type (vlax-get tmpObj Prop)) 'VLA-OBJECT)
  127.       (/= (get_tile "PropsEditbox") "*Error getting value!!")
  128.       (not (equal NewValue OldValue 0.0001))
  129.     )
  130.     (set_tile
  131.       "set-title"
  132.       (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put (list tmpObj Prop NewValue)))
  133.         (strcat ARCH#LOGO " : PROPS                           Get Properties" " : Could not update property \"" Prop "\"!!")
  134.         (progn
  135.           (start_list "PropsListbox" 3)
  136.           (mapcar
  137.             (function
  138.               (lambda ( x )
  139.                 (add_list
  140.                   (strcat
  141.                     x
  142.                     "\t"
  143.                     (vl-princ-to-string
  144.                       (if (vl-catch-all-error-p (setq tmpChk (vl-catch-all-apply 'vlax-get (list tmpObj x))))
  145.                         (strcat ARCH#LOGO " : PROPS                           Get Properties" " : Error getting value!!")
  146.                         tmpChk
  147.                       )
  148.                     )
  149.                   )
  150.                 )
  151.               )
  152.             )
  153.             PropList
  154.           )
  155.           (end_list)
  156.           (strcat ARCH#LOGO " : PROPS                           Get Properties" " : Updated property \"" Prop "\"")
  157.         )
  158.       )
  159.     )
  160.     (progn
  161.       (mode_tile "PropsEditbox" 1)          
  162.       (set_tile "set-title" (strcat ARCH#LOGO " : PROPS                           Get Properties" " : Not able to edit property."))
  163.     )
  164.   )
  165. )
  166. ;----------------------------------------------------------------------------------------------
  167. (defun ListboxSelection ( / tmpNum Prop )
  168.   (setq tmpNum (read (get_tile "PropsListbox")))
  169.   (setq Prop (nth tmpNum PropList))
  170.   (if
  171.     (or
  172.       (not (vlax-property-available-p tmpObj Prop T))
  173.       (= (type (vlax-get tmpObj Prop)) 'VLA-OBJECT)
  174.       (= (get_tile "PropsEditbox") "*Error getting value!!")
  175.     )
  176.     (mode_tile "PropsEditbox" 1)
  177.     (mode_tile "PropsEditbox" 0)
  178.   )
  179.   (set_tile "TextLabel" Prop)
  180.   (set_tile "PropsEditbox" (vl-princ-to-string (vlax-get tmpObj Prop)))
  181.   (cond
  182.     ( (or (= (strcase Prop) "LAYER")
  183.           (= (strcase Prop) "LINETYPE")
  184.           (= (strcase Prop) "STYLENAME")
  185.           (= (strcase Prop) "TEXTSTYLE")
  186.       )
  187.       (mode_tile "PickPt" 1)
  188.       (mode_tile "PickList" 0)
  189.     )
  190.     ( (vl-string-search "POINT" (strcase Prop))
  191.       (mode_tile "PickPt" 0)
  192.       (mode_tile "PickList" 1)
  193.     )
  194.     ( t
  195.       (mode_tile "PickPt" 1)
  196.       (mode_tile "PickList" 1)
  197.     )
  198.   )
  199.   (mode_tile "PropsEditbox" 2)
  200. )
  201. ;----------------------------------------------------------------------------------------------
  202. (defun PickFromList ( dch / tmpList tmpValue Prop OldValue )
  203.   (setq Prop (get_tile "TextLabel"))
  204.   (setq OldValue (get_tile "PropsEditbox"))
  205.   (if (not (new_dialog "MyPropsList" dch "" '(-1 -1))) ;(not (new_dialog "MyPropsList" DiaLoad))
  206.     (exit)
  207.   )
  208.   (cond
  209.     ( (= (strcase Prop) "LAYER") (setq tmpList LayList) )
  210.     ( (= (strcase Prop) "LINETYPE") (setq tmpList LTList) )
  211.     ( (= (strcase Prop) "STYLENAME")
  212.       (if ObjDim
  213.         (setq tmpList DimList)
  214.         (setq tmpList StyList)
  215.       )
  216.     )
  217.     ( (= (strcase Prop) "TEXTSTYLE") (setq tmpList StyList) )
  218.   )
  219.   (start_list "PropsListbox2")
  220.   (mapcar (function add_list) tmpList)
  221.     "PropsListbox2"
  222.     "(if (= $reason 1) (progn (setq tmpValue (nth (read (get_tile \"PropsListbox2\")) tmpList)) (done_dialog 1)))")
  223.     "cancel"
  224.     "(progn (setq tmpValue OldValue) (done_dialog 0))")
  225.     tmpValue
  226.   )
  227. )
  228. ;----------------------------------------------------------------------------------------------
  229. (defun DialogPortion ( dcl TextLabel Point / tmpProp )
  230.   (setq ARCH#LOGO " Tim Willey's")
  231.   (if (minusp (setq dch (load_dialog dcl)))
  232.     (exit)
  233.   )
  234.   ;(setq DiaLoad (load_dialog "ARCH_GrabProperties.dcl"))
  235.   (if (not (new_dialog "MyPropsTest" dch "" '(-1 -1))) ;(not (new_dialog "MyPropsTest" DiaLoad))
  236.     (exit)
  237.   )
  238.   (set_tile "set-title" (strcat ARCH#LOGO " : PROPS                           Get Properties"))
  239.   (mode_tile "PickPt" 1)
  240.   (mode_tile "PickList" 1)
  241.   (start_list "PropsListbox" 3)
  242.   (mapcar
  243.     (function
  244.       (lambda ( x )
  245.         (add_list
  246.           (strcat
  247.             x
  248.             "\t"
  249.             (vl-princ-to-string
  250.               (if (vl-catch-all-error-p (setq tmpChk (vl-catch-all-apply 'vlax-get (list tmpObj x))))
  251.                 "*Error getting value!!"
  252.                 tmpChk
  253.               )
  254.             )
  255.           )
  256.         )
  257.       )
  258.     )
  259.     PropList
  260.   )
  261.   (if TextLabel
  262.     (set_tile "TextLabel" TextLabel)
  263.     ;(set_tile "TextLabel" "")
  264.   )
  265.   (if Point
  266.     (set_tile "PropsEditbox" Point)
  267.     ;(set_tile "PropsEditbox" "")
  268.   )
  269.   (action_tile "PickPt" "(progn (setq tmpProp (get_tile \"TextLabel\")) (done_dialog 3))")
  270.   (action_tile "PickList" "(set_tile \"PropsEditbox\" (PickFromList dch))")
  271.   (action_tile "PropsListbox" "(if (= $reason 1) (ListboxSelection))")
  272.   (action_tile "accept" "(ApplyToObject)")
  273.   (action_tile "cancel" "(done_dialog 0)")
  274.   (if (= (start_dialog) 3)
  275.     (PickPoint dcl tmpProp)
  276.   )
  277. )
  278. ;----------------------------------------------------------------------------------------------
  279. (defun PickPoint ( dcl tmpProp / tmpPt )
  280.   (setq tmpPt (getpoint (strcat "\n Select new \"" tmpProp "\": ")))
  281.   (DialogPortion dcl tmpProp (vl-princ-to-string tmpPt))
  282. )
  283. ;----------------------------------------------------------------------------------------------
  284.  
  285. (defun c:PRPS          ( / *error* _findfile LM:str->lst strip_dcl lspfile dcp dcl dch ActDoc LayList StyList LTList DimList Sel tmpObj PropList
  286.                             ColumnLng Columns Remander ListCnt ColumnCnt DiaFile Opened
  287.                             DiaLoad GetPointCnt BlkList PageTwo ObjDim ARCH#LOGO )
  288.                            ;|  Creates a dialog box with all the properties available per object selected.  Ones that can't be
  289.     edited are greyed out, but this show you what they are.
  290.     With objects that have the property coordiantes, you have to enter them in the way they are shown.
  291.     I'm trying to find a better way to do this, but until then.  Objects that have points, have a pick button
  292.     next to them, but that doesn't work right now, so you have to enter the new point value as a list.
  293.     Thanks to Michael Puckett for the codes provided within the routine.
  294.     Use at your own risk.  Tested one A2k4.  Change to suite your needs.  I am not to be blamed for anything
  295.     that happens to your computer if you use this routine, and neither is anyone else named in this routine.
  296.     v1.0 Issued for use.  12/27/05
  297.     v2.0 Changed the layout.  It no longers writes it own dialog box.  It puts all the properties into one
  298.          dialog box, and you can edit them form there.  Weither you pick it from a list, or pick a point.
  299.          I like the other format better, but this is the only way I could get it to work with being able
  300.          to pick a point, and work with the length of all the dimension properties.  Changed how you call it
  301.          just incase people want to see the difference.
  302.          12/28/05
  303. |;
  304.  
  305.  
  306.   (defun *error* ( m )
  307.     (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
  308.     (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 ;;;
  309.     (and m (prompt m))
  310.     (princ)
  311.   )
  312.  
  313.   (defun _findfile ( libraryrootprefix filenamepattern / subs processsubfolders folders r ) ;;; (_findfile "F:\\ACAD ADDONS-NEW\\" "profile*.lsp")
  314.  
  315.     (defun subs ( folder )
  316.       (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))
  317.     )
  318.  
  319.     (defun processsubfolders ( rootfolder / subfolders )
  320.       (setq subfolders (subs rootfolder))
  321.       (foreach sub subfolders
  322.         (if (= (substr rootfolder (strlen rootfolder)) "\\")
  323.           (setq r (cons (strcat rootfolder sub) (processsubfolders (strcat rootfolder sub))))
  324.           (setq r (cons (strcat rootfolder "\\" sub) (processsubfolders (strcat rootfolder "\\" sub))))
  325.         )
  326.       )
  327.       r
  328.     )
  329.  
  330.     (setq folders (append (list libraryrootprefix) (processsubfolders libraryrootprefix)))
  331.     (vl-some
  332.       (function
  333.         (lambda ( y )
  334.           (if
  335.             (and
  336.               y
  337.               (setq x
  338.                 (vl-some
  339.                   (function
  340.                     (lambda ( x )
  341.                       (if (findfile (strcat y "\\" x))
  342.                         x
  343.                       )
  344.                     )
  345.                   )
  346.                   (vl-directory-files y filenamepattern 1)
  347.                 )
  348.               )
  349.             )
  350.             (strcat y "\\" x)
  351.           )
  352.         )
  353.       ) folders
  354.     )
  355.   )
  356.  
  357.   (setq lspfile (_findfile "C:\\ACAD ADDONS-NEW\\" "PRPS.lsp"))
  358.  
  359.   (stripsubs) ;;; loading subs for striping DCL from this LSP with DCL in normal form (LSP = source file of DCL) ;;;
  360.  
  361.   (setq dcp (strip_dcl lspfile))
  362.   (setq dcl (apply (function strcat) (cdr (fnsplitl dcp))))
  363.  
  364.  
  365.   (if (not GlbVarPropertiesList)
  366.     (setq GlbVarPropertiesList (GetVlaProperties (GetVlaAtoms)))
  367.   )
  368.   (vla-StartUndoMark ActDoc)
  369.   (vlax-for Lay (vla-get-Layers ActDoc)
  370.     (if (not (vl-string-search "|" (vla-get-Name Lay)))
  371.       (setq LayList (cons (vla-get-Name Lay) LayList))
  372.     )
  373.   )
  374.   (setq LayList (vl-sort LayList '<))
  375.   (vlax-for Sty (vla-get-TextStyles ActDoc)
  376.     (if (not (vl-string-search "|" (vla-get-Name Sty)))
  377.       (setq StyList (cons (vla-get-Name Sty) StyList))
  378.     )
  379.   )
  380.   (setq StyList (vl-sort StyList '<))
  381.   (vlax-for LT (vla-get-LineTypes ActDoc)
  382.     (if (not (vl-string-search "|" (vla-get-Name LT)))
  383.       (setq LTList (cons (vla-get-Name LT) LTList))
  384.     )
  385.   )
  386.   (setq LTList (vl-sort LTList '<))
  387.   (vlax-for Dims (vla-get-DimStyles ActDoc)
  388.     (if (not (vl-string-search "|" (vla-get-Name Dims)))
  389.       (setq DimList (cons (vla-get-Name Dims) DimList))
  390.     )
  391.   )
  392.   (setq DimList (vl-sort DimList '<))
  393.   (vlax-for Blk (vla-get-Blocks ActDoc)
  394.     (if (not (vl-string-search "|" (vla-get-Name Blk)))
  395.       (setq BlkList (cons (vla-get-Name Blk) BlkList))
  396.     )
  397.   )
  398.   (setq BlkList (vl-sort BlkList '<))
  399.   (if
  400.     (and
  401.       (not (initget "Nested"))
  402.       (setq Sel (entsel "\n* Select object to edit properties [or Nested to selected nested object]: "))
  403.       (if (= Sel "Nested")
  404.         (setq Sel (nentsel "\n* Select nested object: "))
  405.         Sel
  406.       )
  407.     )
  408.     (progn
  409.       (if (= (cdr (assoc 0 (entget (car Sel)))) "DIMENSION")
  410.         (setq ObjDim T)
  411.       )
  412.       (setq tmpObj (vlax-ename->vla-object (car Sel)))
  413.       (setq PropList (vl-remove-if-not (function (lambda ( x ) (vlax-property-available-p tmpObj x))) GlbVarPropertiesList))
  414.       (setq PropList (vl-sort PropList (function (lambda ( a b ) (< (strcase a) (strcase b))))))
  415.       (DialogPortion dcl nil nil)
  416.     )
  417.   )
  418.   (vla-Regen ActDoc acActiveViewport)
  419.   (vla-EndUndoMark ActDoc)
  420.   (*error* nil)
  421. )
  422.  
« Last Edit: March 27, 2022, 02:27:34 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 2701
  • Marko Ribar, architect
Re: Classical way to use dialogs
« Reply #5 on: March 26, 2022, 11:23:20 AM »
Another one - just it can't be posted in code tags - above 20000 chars...

Atteached as *.lsp...
« Last Edit: March 27, 2022, 02:28:06 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube