Leaderboard

I have a program that does this. It also adds each closed polyline area and tag into a sql database that be queried. It can then display it on a website. Sure it cost $250k to buy and install and costs us about $25K annually. It's called Archibus. Look over at leemac's website to see what he has... http://www.lee-mac.com/arealabel.html

Coming back to this one again, this version uses the same idea I had above but closes each dialogue box and opens a new one which gets past the 8 children problem There are 4 defuns in this, one for each tab (create more or less as you want), and currently they return the variable 'MyTab'. If you want to keep any variables entered into a dialogue I would have 'MyTab' as a list, the first item being the selected next tab to go to, and after that include in the list all the other variables, perhaps for the full dialogue box, and update that as the user selects controls. Am sure you can work out passing numbers backwards and forwards and repopulating the dialogue boxes with that. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab1 ( / dcl1 des1 dch1 x MyTab) ;;;DCL 1 ;;DCL on the fly: Ideas by Lee Mac and Cadtutor forums ;;create DCL pop up box (if (and (setq dcl1 (strcat (getvar "TEMPPREFIX") "DCLTab1.dcl")) (setq des1 (open dcl1 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"A Dialogue Box\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 1'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Lets Make DCL!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"and put all the fun bits here\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des1) ) (not (setq des1 (close des1))) (< 0 (setq dch1 (load_dialog dcl1))) (new_dialog "pass" dch1) ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(term_dialog)(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(term_dialog)(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(term_dialog)(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(term_dialog)(done_dialog 1)") (action_tile "accept" "(done_dialog 1)(term_dialog)") (action_tile "cancel" "(done_dialog 0)(term_dialog)") (start_dialog) ) ;;end of DCL1 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL1 'if' above (vl-file-delete dcl1) ;;delete the temp DCL file MyTab ) ; end defun tab 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab2 ( / dcl2 des2 dch2 x MyTab) (if (and (setq dcl2 (strcat (getvar "TEMPPREFIX") "DCLTab2.dcl")) (setq des2 (open dcl2 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"Popped Up to say Hello\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 2'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Aha!! Tab 2!!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"put more fun bits here\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des2) ) (not (setq des2 (close des2))) (< 0 (setq dch2 (load_dialog dcl2))) (new_dialog "pass" dch2) (princ "Tab 2 Loaded") ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(term_dialog)(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(term_dialog)(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(term_dialog)(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(term_dialog)(done_dialog 1)") (action_tile "accept" "(done_dialog 1)(term_dialog)") (action_tile "cancel" "(done_dialog 0)(term_dialog)") (start_dialog) ) ;;end of DCL2 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL2 'if' above (vl-file-delete dcl2) ;;delete the temp DCL file MyTab ) ; end defun tab 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab3 ( / dcl3 des3 dch3 x MyTab) (if (and (setq dcl3 (strcat (getvar "TEMPPREFIX") "DCLTab3.dc3")) (setq des3 (open dcl3 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"The popped away again\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 3'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Now your talking, Tab 3!!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"good this,\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des3) ) (not (setq des3 (close des3))) (< 0 (setq dch3 (load_dialog dcl3))) (princ "Tab 3 Loaded") (new_dialog "pass" dch3) ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(term_dialog)(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(term_dialog)(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(term_dialog)(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(term_dialog)(done_dialog 1)") (action_tile "accept" "(done_dialog 1)(term_dialog)") (action_tile "cancel" "(done_dialog 0)(term_dialog)") (start_dialog) ) ;;end of DCL3 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL3 'if' above (vl-file-delete dcl3) ;;delete the temp DCL file MyTab ) ; end defun tab 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab4 ( / dcl4 des4 dch4 x MyTab) (if (and (setq dcl4 (strcat (getvar "TEMPPREFIX") "DCLTab4.dcl")) (setq des4 (open dcl4 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"This is Tab 4 by the way\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 4'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Look who'se talkng!!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"to you. Anopther Tab!!\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des4) ) (not (setq des4 (close des4))) (< 0 (setq dch4 (load_dialog dcl4))) (princ "Tab 4 Loaded") (new_dialog "pass" dch4) ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(done_dialog 1)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (start_dialog) ) ;;end of DCL4 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL4 'if' above (vl-file-delete dcl4) ;;delete the temp DCL file MyTab ;;change this to a list with all variables in it. Repopulate tab when it is opened again ) ; end defun tab 4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:testthis ( / ) (setq MyTab (Tab1)) (setq Done "Not") (while (= Done "Not") (if (= MyTab nil)(setq Done "Yes")) (if (/= MyTab nil)(setq MyTab (eval (read (strcat "(" MyTab ")"))) ) ) ); end while

Thanks Steve

Hi, thanks, I've tested initially and this works really well so far. Cheers.

Kenny Ramage here. (AfraLisp) Semi retired now but would like to help out especially with the basics.

Many thanks it still didn´t work.(Think color is wrong) But I just relized that the only hatch that will ever be placed on the layer is the hatch im looking for! (defun c:test (/ blockss) (if (setq blockss (ssget "_X" '( (0 . "HATCH") (8 . "B-B-U0013") (410 . "Model") ))) ;find specific blocks on current Model (prompt "\nIt exist") (prompt "\nNope") ) (princ "test") ) This was the solution, could not have done it without you mhupp! Thanks!

Modifying the one you have to allow either entering an angle or using snaps to set snapang then using that value for dview twist: ^C^C^P(setvar 'angdir 1)(setvar 'snapang (getangle "Pick or enter TWist angle : "))(setvar 'angdir 0)(command "_.dview" "l" "" "_tw" (/(*(-(getvar 'snapang))180)pi) "") To make sure angdir is reset and to unlock then relock a viewport you want to twist this slight modification of BlackBox's lisp is what I'm using: (vl-load-com) ;;; Alternative Macro to allow either entering an angle or using snaps to set snapang then using that value for dview twist: ;;; ^C^C^P(setvar 'angdir 1)(setvar 'snapang (getangle "Pick or enter TWist angle : "))(setvar 'angdir 0)(command "_.dview" "l" "" "_tw" (/(*(-(getvar 'snapang))180)pi) "") ;;;--------------------------------------------------------------------; ;;; Twist dview function by BlackBox https://forums.augi.com/showthread.php?174367-multiline-text-rotation&p=1344593#post1344593 ;;; Modified to allow either entering an angle or using snaps to set snapang then using that value for dview twist: ;;; (defun c:TW () (c:TWIST)) ;;; ^P(or C:TWist (load "TWist.lsp"));TWist ;;; (load "TWist.lsp") TWist (defun c:TWist (/ *error* cmdecho angdir snapang osmode acDoc ActiveVport NotLock) (prompt "\rTWist") (defun *error* (msg) (and cmdecho (setvar 'cmdecho cmdecho)) (and angdir (setvar 'angdir angdir)) ; (and snapang (setvar 'snapang snapang)) (and osmode (setvar 'osmode osmode)) (if acDoc (vla-endundomark acDoc) ) (or (= NotLock 1)(vla-put-DisplayLocked ActiveVport :vlax-true)) (cond ((not msg)) ; Normal exit ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit) ((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it ) (princ) ) (if (and (setq cmdecho (getvar 'cmdecho)) (setvar 'cmdecho 0) (or (= 1 (getvar 'tilemode)) (and (= 0 (getvar 'tilemode))(< 1 (getvar 'cvport))) ) (setq angdir (getvar 'angdir)) (setvar 'angdir 1) (setq osmode (getvar 'osmode)) (setvar 'osmode 512) ; (setq snapang (getvar 'snapang)) ) (progn (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object))) ) (if (= 0 (getvar 'tilemode)) (progn (setq ActiveVport (vla-get-ActivePViewport acDoc) VpLock (vla-get-DisplayLocked ActiveVport) ) ; (princ "\n(= 0 (getvar 'tilemode)) = ")(princ (= 0 (getvar 'tilemode))) (if (equal :vlax-true VpLock) (vla-put-DisplayLocked ActiveVport :vlax-false) (setq NotLock 1) ) ;if (equal :vlax-true VpLock) ) ) ;if (= 0 (getvar 'tilemode) (progn (setvar 'snapang (getangle "Pick or enter TWist angle : ")) (command "._dview" "l" "" "_tw" (/(*(-(getvar 'snapang))180)pi) "" ) (setvar 'angdir angdir) (or (= NotLock 1)(vla-put-DisplayLocked ActiveVport :vlax-true)) ) ;progn ) ;progn (alert "\nMust be in a Layout's viewport or the Model tab!") ) (*error* nil) )

(defun c:LLC ( / js dxf_cod mod_sel n lremov str_sep oldim ename X1 Y1 X2 Y2 col tmp f_open) (princ "\nSelect a model object to make filter: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "LINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nIsn't a Line!") ) (vl-load-com) (setq dxf_cod (entget (ssname js 0))) (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 48))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) (initget "Single All Manual") (if (eq (setq mod_sel (getkword "\nApply filter to ? [Single/All/Manual]<Manual>: ")) "Single") (setq n -1) (if (eq mod_sel "All") (setq js (ssget "_X" dxf_cod) n -1) (setq js (ssget dxf_cod) n -1) ) ) (setq tmp (vl-filename-mktemp "tmp.csv") f_open (open tmp "w") str_sep ";" oldim (getvar "dimzin") ) (setvar "dimzin" 0) (write-line (strcat "X1" str_sep "Y1" str_sep "X2" str_sep "Y2" str_sep "Color") f_open) (repeat (sslength js) (setq ename (ssname js (setq n (1+ n))) dxf_cod (entget ename) X1 (cadr (assoc 10 dxf_cod)) Y1 (caddr (assoc 10 dxf_cod)) X2 (cadr (assoc 11 dxf_cod)) Y2 (caddr (assoc 11 dxf_cod)) ) (write-line (strcat (rtos X1 2 3) str_sep (rtos Y1 2 3) str_sep (rtos X2 2 3) str_sep (rtos Y2 2 3) str_sep (if (assoc 420 dxf_cod) (progn (setq col (LM:True->RGB (cdr (assoc 420 dxf_cod)))) (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col))) ) (progn (cond ((= (assoc 62 dxf_cod) 256) "by layer" ) ((= (assoc 62 dxf_cod) 0) "by block" ) (t (setq col (LM:ACI->RGB (cdr (assoc 62 dxf_cod)))) (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col))) ) ) ;end of cond ) ;end of progn ) ;end of if ) f_open ) ) (close f_open) (startapp "notepad" tmp) (setvar "dimzin" oldim) (prin1) ) ;; True -> RGB - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)) ) ;; ACI -> RGB - Lee Mac ;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255) (defun LM:ACI->RGB ( c / o r ) (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) (progn (setq r (vl-catch-all-apply '(lambda ( ) (vla-put-colorindex o c) (list (vla-get-red o) (vla-get-green o) (vla-get-blue o)) ) ) ) (vlax-release-object o) (if (vl-catch-all-error-p r) (prompt (strcat "\nError: " (vl-catch-all-error-message r))) r ) ) ) ) ;; Application Object - Lee Mac ;; Returns the VLA Application Object (defun LM:acapp nil (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object))) (LM:acapp) ) like this, this code is not tested

Look at help Entsel when using LISP, Nentsel for me means pick a bit deeper object, like a block attribute. https://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-A7AC0917-66CE-4BAA-BBAF-D49F8ADB26B1