Code Red > Visual DCL Programming
Classical way to use dialogs
ribarm:
Another one - just it can't be posted in code tags - above 20000 chars...
Atteached as *.lsp...
ribarm:
Some addition to main example - added sub function (fullpath-running_lsp) for determining full path by searching all HD drives with recursive method... Main option could be time consuming and could also lead to getting duplicate file instead of correct original location, but it IS some kind of improvement to this story of smart DCL handling inside master LSP...
--- Code: ---;;;----------------------------------------------------------------------------;;;
;;; ;;;
;;; 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 file
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"; }
}
|; 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 fullpath-running_lsp ( / _findfile _lstprmpt _drives filename fullpath ) ;;; main function - could be command function also, but active filename should match with it's name - i.e. for this example file should be saved as "fullpath-running_lsp.lsp" ;;;
(defun _findfile ( libraryrootprefix filenamepatternlst subfoldersflag / subs processsubfolders folders r ) ;;; (_findfile "F:\\ACAD ADDONS-NEW" (list "profile*.lsp" "profile*.arg") t) ;;; searches for specific file and returns it's full path and filename with extension as soon as it finds first matching occurence ;;;
(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) (if subfoldersflag (processsubfolders libraryrootprefix) folders)))
(vl-some
(function
(lambda ( y )
(if
(and
y
(setq x
(vl-some
(function
(lambda ( x )
(if (findfile (strcat y "\\" x))
x
)
)
)
(car
(vl-remove nil
(mapcar
(function (lambda ( filenamepattern )
(vl-directory-files y filenamepattern 1)
))
filenamepatternlst
)
)
)
)
)
)
(strcat y "\\" x)
)
)
) folders
)
)
(defun _lstprmpt ( / prmpt )
(setq prmpt (getvar 'lastprompt))
(setq prmpt (substr prmpt (+ 2 (vl-string-position (ascii " ") prmpt))))
(cond
( (or
(= "(c:" (substr prmpt 1 3))
(= "(C:" (substr prmpt 1 3))
)
(setq prmpt (substr prmpt 4 (- (strlen prmpt) 4)))
)
( (= "(" (substr prmpt 1 1))
(setq prmpt (substr prmpt 2 (- (strlen prmpt) 2)))
)
)
prmpt
)
(defun _drives ( / i d r )
;; Tharwat - Date: 24.Apr.2017 ;;
(setq i 64)
(while (< i 91)
(if (vl-file-directory-p (setq d (strcat (chr (setq i (1+ i))) ":")))
(setq r (cons d r))
)
)
(vl-sort r (function <))
)
(setq filename (strcat (_lstprmpt) ".lsp"))
(setq fullpath
(vl-some
(function (lambda ( drive / fn )
(if (setq fn (_findfile drive (list filename) t))
fn
)
))
(_drives)
)
)
fullpath
)
(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 ;;;
(initget "Yes No")
(cond
( (/= "No" (getkword "\nSearch for actively running lisp - this file [Yes / No] <Yes> : "))
(setq lspfile (fullpath-running_lsp))
)
( t
(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
--- End code ---
keithsCADservices:
I've been hammering away hard at learning different dialogs in C#. DCL is really underrated (and same applies to OpenDCL, but perhaps to an even higher magnitude). Lots of people just want to get stuff done and don't care how pretty the dialog is. With that said, if your a "form is function" type person, DCL is pretty pleasing to the eyes ;-) .
Cool stuff and thanks for sharing.
BIGAL:
Yeah to me its was the few lines of code to have a single enter value pop in screen than rather take your eyes down to lower left corner and enter a value.
Then follow that with multiple requests and realise that the 1st one was wrong.
Navigation
[0] Message Index
[*] Previous page
Go to full version