Jump to content

DCL with Check boxes to Insert drawings


mstg007

Recommended Posts

I'm sure this sounds crazy. I am trying see how to setup a dcl that can insert drawings.

 

For example, If I have a DCL with 8 check boxes. Check box names would be the number name, (1, 2, 3, 4, 5, 6, 7, 8).

 

The drawings name would be the same as the number name. (1.dwg, 2.dwg, 3.dwg, 4.dwg, 5.dwg, 6.dwg, 7.dwg, 8.dwg)

 

If I check box 1,6,7 and then select the execute button, would it insert those drawings into the current drawing?

Thank you for any help!

Link to comment
Share on other sites

A simpler method is to use menu's you have image tiles that can have basically as many dwg's as you  like picking a icon or by name and can be inserted etc. The other way is to use tool palettes again as many as you like.

 

 

 

 

 

 

Screen Shot 12-04-18 at 08.31 AM.PNG

Link to comment
Share on other sites

don't have the time for much testing right now but this quickly written routine should get you started

 

(defun c:mstg007 ( / err actDoc dcl-fn dcl-fp dcl-id old-attreq iList)
  (mstg007_Init)
  (mstg007_Start_Dialog)
  (mstg007_Exit)
  (princ)
)

(defun mstg007_Err (s) (princ s)(mstg007_Exit)(princ))

(defun mstg007_Exit ()
  (setq *error* err)
  (if dcl-fp (close dcl-fp))
  (if dcl-id (unload_dialog dcl-id))
  (if (and dcl-fn (findfile dcl-fn))(vl-file-delete (findfile dcl-fn)))
  (setvar 'attreq old-attreq)
  (princ)
)

(defun mstg007_Init ()
  (vl-load-com)
  (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq dcl-fn (strcat (getvar 'ROAMABLEROOTPREFIX) "mstg007.dcl"))
  (setq old-attreq (getvar 'attreq)) (setvar 'attreq 0)
  (mstg007_write_dialog)
)

(defun mstg007_write_dialog ( / i)
  (if (and dcl-fn (setq dcl-fp (open dcl-fn "w"))(setq i 1))
    (progn
      (write-line "mstg007:dialog{label=\"mstg007\";" dcl-fp)
      (repeat 10
	(write-line (strcat ":toggle {key=\"tg" (itoa i) "\";label=\"" (itoa i) "\";}") dcl-fp)
	(setq i (1+ i))
      )
      (write-line "spacer;ok_cancel;}" dcl-fp)
      (close dcl-fp)
    )
    (alert "Unable to create dialog")
  )
)

(defun mstg007_Start_Dialog ( / drv )
  (if (and (setq dcl-id (load_dialog dcl-fn)) (new_dialog "mstg007" dcl-id))
    (progn
      (mstg007_DialogActions)
      (setq drv (start_dialog))
      (if dcl-id (unload_dialog dcl-id))
      (if (= drv 1) (mstg007_insert_blocks))
    )
  )
)

(defun mstg007_DialogActions ( / n)
  (setq n 1)
  (repeat 10
    (action_tile (strcat "tg" (itoa n)) "(mstg007_add_block $key $value)")
    (setq n (1+ n))
  )
  (action_tile "ok"	"(done_dialog 1)")
  (action_tile "cancel"	"(done_dialog 0)")
)

(defun mstg007_add_block (key val)
  (if (and (eq val "1")(not (member key iList)))
    (setq iList (cons key iList))
    (if (and (eq val "0")(member key iList))
      (setq iList (vl-remove key iList))
    )
  )
)

(defun mstg007_insert_blocks ( / b bn)
  (if (vl-consp iList)
    (foreach b (reverse iList)
      (setq bk (strcat (substr b 3) ".dwg"))
      (if (setq bn (findfile bk))
	(vla-insertblock (vla-get-ModelSpace actDoc) (vlax-3d-point 0 0 0) bn 1 1 1 0)
	(princ (strcat "\nBlock not found : " bk))
      )
    )
  )
  (terpri)
  (princ)
)

(c:mstg007)

 

Edited by rlx
Link to comment
Share on other sites


(defun c:mstg007b ( / err actDoc dcl-fn dcl-fp dcl-id old-attreq bkl-col1 bkl-col2 iList)
  (mstg007b_Init)
  (mstg007b_Start_Dialog)
  (mstg007b_Exit)
  (princ)
)

(defun mstg007b_Err (s) (princ s)(mstg007b_Exit)(princ))

(defun mstg007b_Exit ()
  (setq *error* err)
  (if dcl-fp (close dcl-fp))
  (if dcl-id (unload_dialog dcl-id))
  (if (and dcl-fn (findfile dcl-fn))(vl-file-delete (findfile dcl-fn)))
  (setvar 'attreq old-attreq)
  (princ)
)

(defun mstg007b_Init ()
  (vl-load-com)
  (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq dcl-fn (strcat (getvar 'ROAMABLEROOTPREFIX) "mstg007b.dcl"))
  (setq old-attreq (getvar 'attreq)) (setvar 'attreq 0)
  (setq bkl-col1 (list "1" "2" "3" "4"))
  (setq bkl-col2 (list "5" "6" "7" "8"))
  (mstg007b_write_dialog)
)

(defun mstg007b_write_dialog ( / ) ; i
  (if (and dcl-fn (setq dcl-fp (open dcl-fn "w"))) ;(setq i 1))
    (progn
      (write-line "mstg007b:dialog{label=\"mstg007b\";" dcl-fp)
       (write-line ":row {:column{width=1;}:column {" dcl-fp)
        (mapcar '(lambda (x) (write-line (strcat ":toggle {key=\"tg_" x "\";label=\"  " x "\";}") dcl-fp)) bkl-col1)
         (write-line "} :column {" dcl-fp)
          (mapcar '(lambda (x) (write-line (strcat ":toggle {key=\"tg_" x "\";label=\"  " x "\";}") dcl-fp)) bkl-col2)
           (write-line "}}spacer;spacer;ok_cancel;}" dcl-fp)
      (close dcl-fp)
    )
    (alert "Unable to create dialog")
  )
)

(defun mstg007b_Start_Dialog ( / drv )
  (if (and (setq dcl-id (load_dialog dcl-fn)) (new_dialog "mstg007b" dcl-id))
    (progn
      (mstg007b_DialogActions)
      (setq drv (start_dialog))
      (if dcl-id (unload_dialog dcl-id))
      (if (= drv 1) (mstg007b_insert_blocks))
    )
  )
)

(defun mstg007b_DialogActions ()
  (mapcar
    '(lambda (x) (action_tile (strcat "tg_" x) "(mstg007b_add_block $key $value)"))
     (append bkl-col1 bkl-col2)
  )
  (action_tile "ok" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
)

(defun mstg007b_add_block (key val)
  (if (and (eq val "1")(not (member key iList)))
    (setq iList (cons key iList))
    (if (and (eq val "0")(member key iList))
      (setq iList (vl-remove key iList))
    )
  )
)

(defun mstg007b_insert_blocks ( / b bn)
  (if (vl-consp iList)
    (foreach b (reverse iList)
      (setq bk (strcat (substr b 4) ".dwg"))
      (if (setq bn (findfile bk))
 (vla-insertblock (vla-get-ModelSpace actDoc) (vlax-3d-point 0 0 0) bn 1 1 1 0)
 (princ (strcat "\nBlock not found : " bk))
      )
    )
  )
  (vla-regen actDoc acActiveViewport)
  (terpri)
  (princ)
)

(c:mstg007b)

 

Link to comment
Share on other sites

15 hours ago, BIGAL said:

A simpler method is to use menu's you have image tiles that can have basically as many dwg's as you  like picking a icon or by name and can be inserted etc. The other way is to use tool palettes again as many as you like.

 

 

 

 

 

 

Screen Shot 12-04-18 at 08.31 AM.PNG


Just curious, with this method, can the user select multiple "slides" to insert in one? RLX seems to do that pretty well.

Link to comment
Share on other sites

you're welcome.

 

The classic icon menu BIGAL is showing doesn't support multiple selection as far as I know. But the advantage is that its simple and a well documented AutoCAD feature and most of the time I do like things to be simple and stable. One disadvantage of lisp routines can be (from a companies perspective) they work well while their daddy is around, but when that person leaves the company and this program needs updating with the next AutoCAD version, there may not be anyone available with the knowledge to do this. So while my colleagues like me to make stuff , there are certain things my boss here doesn't want me to do. Not because I wouldn't be able to, but just because they would need a RLX2.0 to keep things running in the future.  Having said all that , it would be possible to make a dialog resembling an icon menu and have the ability for multiple selection. And because there are already so many insert routines , big chance what you want is already out there and you just have to find (google) it.

 

gr. Rlx

Link to comment
Share on other sites

Nice work @rlx ! 🍻

Heres something I assembled just now, for fun and practice:

(defun C:test ( / env ncol dwgL GetDwgs GetFolder GroupByN *error* tgcache dcl des dch dcf dwgs )
  
  (setq env "InsertDwgs")
  
  (setq ncol
    (
      (lambda ( / tmp )
        (cond
          ( (setq tmp (getenv "InsertDwgsNcols")) (atoi tmp) )
          ( (setq tmp 12) (setenv "InsertDwgsNcols" (itoa tmp)) tmp)
        )
      )
    )
  )
  
  (setq dwgL
    (
      (lambda ( env / tmp )
        (cond 
          ( (not (setq tmp (getenv env))) nil)
          ( (read tmp) )
        )
      )
      env
    )
  )
  
  (setq GetDwgs
    (lambda ( env / fld L r )
      (cond 
        ( (not (setq fld (GetFolder "Select folder with dwg files" nil nil))) )
        ( (not (setq L (vl-directory-files fld "*.dwg" 1))) )
        ( (setenv env (vl-prin1-to-string (setq r (cons fld L)))) )
      )
      r
    )
  )
  
  
  (defun GetFolder ( msg defpath newfolderopt / shell folder parentfolder path )
    (vl-catch-all-apply 
      (function
        (lambda nil
          (setq shell (vlax-get-or-create-object "Shell.Application")) 
          (setq folder (vlax-invoke-method shell 'BrowseForFolder 0 (cond (msg)("")) (if newfolderopt 0 512) (cond (defpath) ((strcat (getenv "userprofile") "\\Desktop\\")))))
          (setq parentfolder (vlax-get-property folder 'ParentFolder))
          (setq path (vlax-get-property (vlax-invoke-method parentfolder 'Parsename (vlax-get-property folder 'Title)) 'Path))
        )
      )
    )
    (foreach x (reverse (list shell folder parentfolder path)) (vl-catch-all-apply 'vlax-release-object (list x))) path
  )
  
  (defun GroupByN ( n L / r ) 
    (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r)
    (if L (cons (reverse r) (GroupByN n L)) (list (reverse r)))
  )
  
  (defun *error* ( msg )
    (and (< 0 dch) (unload_dialog dch))
    (and (eq 'FILE (type des)) (close des))
    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
  )
  
  (cond
    ( (not (or dwgL (setq dwgL (GetDwgs env)))) )
    ( (not (setq dcl (vl-filename-mktemp nil nil ".dcl"))) )
    (
      (progn 
        (while (not (member dcf '(0 1)))
          (cond
            (
              (not
                (and (setq des (open dcl "w"))
                  (mapcar (function (lambda (x) (princ (strcat "\n" x) des))) 
                    (list
                      "InsertDrawings : dialog"
                      "{ label = \"Insert Drawings\"; spacer_1; "
                      "   : row"
                      "   { children_alignment = centered; children_fixed_width = true; height = 3.0; fixed_width = true; alignment = centered; "
                      "      : button { label = \"Folder With DWGs >>\"; key = \"fld\"; height = 2.0; }"
                      "      : button { label = \"• Flip Toggles •\"; key = \"inv\"; height = 2.0; }"
                      "      : button { label = \"Insert Drawings >>\"; key = \"ins\"; height = 2.0; }"
                      "   }"
                      "   : boxed_row"
                      "   { children_alignment = centered;"
                      (
                        (lambda ( i )  
                          (apply (function strcat)
                            (mapcar (function (lambda (x) (strcat ": column {"(apply 'strcat x) "}")))
                              (GroupByN ncol
                                (mapcar 
                                  (function 
                                    (lambda (x )
                                      (setq i (1+ i))
                                      (strcat "\n: toggle { key = \"" (itoa i) "\"; label = \"" x "\"; }")
                                    )
                                  )
                                  (cdr dwgL)
                                )
                              )
                            )
                          )
                        )
                        0
                      )
                      "   }"
                      "  spacer_1;"
                      "  : column"
                      "  { label = \"Items Per Column\"; alignment = centered; fixed_width = true; "
                      "    : row" 
                      "    { fixed_width = true; alignment = centered; width = 12;"
                      "      : edit_box { key = \"n\"; edit_width = 3; value = \"1\"; width = 6; }"
                      "      : slider { key = \"n_sld\"; big_increment = 1; small_increment = 1; value = 1; min_value = 0; max_value = 2; width = 3; fixed_width = true; alignment = centered; }"
                      "    }"
                      "    spacer;"
                      "  }"
                      "  spacer_1;"
                      "spacer_1; ok_only; : text { key = \"error\"; }"
                      "}"
                      
                    )
                  )
                  (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
                )
              )
              (prompt "\nUnable to write or load the DCL file.") (setq dcf 0)
            )
            ( (not (new_dialog "InsertDrawings" dch)) (prompt "\nUnable to display the dialog") (setq dcf 0) )
            (T 
              ( 
                (lambda ( / i ) (set_tile "error" "")  (setq i 0) 
                  (mapcar
                    '(lambda (x) 
                      (action_tile (itoa (setq i (1+ i)))
                        (vl-prin1-to-string
                          (append
                            '(
                              (lambda (x)
                                (set_tile "error" (if (= "1" $value) (strcat "Drawing " (vl-prin1-to-string x) " will be inserted") ""))
                              )
                            )
                            (list x)
                          )
                        )
                      )
                    )
                    (cdr dwgL)
                  )
                )
              )
              
              (if tgcache
                (mapcar '(lambda (x) (apply 'set_tile x)) tgcache)
              )
              (action_tile "fld" (vl-prin1-to-string '(done_dialog 2)))
              
              (action_tile "inv"
                (vl-prin1-to-string
                  '( (lambda ( / i ) (set_tile "error" "") (setq i 0) (mapcar '(lambda (x) (setq x (itoa (setq i (1+ i)))) (set_tile x (itoa (rem (1+ (atoi (get_tile x))) 2)))) (cdr dwgL)) ))
                )
              )
              
              (action_tile "ins"
                (vl-prin1-to-string 
                  '(
                    (lambda ( / i )
                      (setq i 0)
                      (if
                        (setq dwgs
                          (apply (function append)
                            (mapcar 
                              (function 
                                (lambda (x / k)
                                  (setq k (itoa (setq i (1+ i))))
                                  (if (= "1" (get_tile k))
                                    (list x)
                                  )
                                )
                              )
                              (cdr dwgL)
                            )
                          )
                        )
                        (progn
                          (setq tgcache ( (lambda ( / i ) (setq i 0) (mapcar '(lambda (x) (list (setq x (itoa (setq i (1+ i)))) (get_tile x))) (cdr dwgL)) )) )
                          (done_dialog 4)
                        )
                        (set_tile "error" "Specify Drawings to insert!")
                      )
                    )
                  )
                )
              )
              
              (set_tile "n" (itoa ncol))
              (setenv "InsertDwgsNcols" (itoa ncol)) 
              (set_tile "n_sld" "1")
              
              (action_tile "n_sld"
                (vl-prin1-to-string
                  '(
                    (lambda ( / val f )
                      (setq val (cond ( (and (numberp (setq tmp (read (get_tile "n")))) (> tmp 1)) tmp ) ( 1 ) ))
                      (if
                        (and 
                          (setq f (eval (cdr (assoc $value '(("0" . 1-)("2" . 1+))))))
                          (> (setq val (f val)) 0)
                        )
                        (progn
                          (set_tile "n" (vl-prin1-to-string val))
                          (setq tgcache ( (lambda ( / i ) (setq i 0) (mapcar '(lambda (x) (list (setq x (itoa (setq i (1+ i)))) (get_tile x))) (cdr dwgL)) )) )
                          (setq ncol val)
                          (done_dialog 3)
                        )
                      )
                      (set_tile "n_sld" "1")
                      
                    )
                  )
                )
              )
              
              (action_tile "n"
                (vl-prin1-to-string
                  '(
                    (lambda ( / tmp )
                      (cond
                        ( 
                          (or 
                            (= "" $value)
                            (not (numberp (setq tmp (read $value))))
                            (< tmp 1)
                          ) 
                          (set_tile "n" (itoa ncol)) 
                        )
                        ( (setq ncol tmp) (setq tgcache ( (lambda ( / i ) (setq i 0) (mapcar '(lambda (x) (list (setq x (itoa (setq i (1+ i)))) (get_tile x))) (cdr dwgL)) )) ) (done_dialog 3) )
                      )
                      (set_tile "nomer_sld" "1")
                    )
                  )
                )
              )
              
              (setq dcf (start_dialog))
            )
          )
          (cond 
            ( (= 2 dcf) 
              (
                (lambda ( / tmp )
                  (if (setq tmp (GetDwgs env))
                    (setq dwgL tmp)
                  )
                )
              )
            )
            ( (= 3 dcf) ) 
            ( (= 4 dcf) 
              (
                (lambda ( / spc pat p )
                  (if 
                    (and 
                      dwgs
                      (setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
                      (setq pat (car dwgL))
                    )
                    (foreach dwg dwgs
                      (if (setq p (getpoint (strcat "\nSpecify point to insert " (vl-prin1-to-string dwg) " :")))
                        (vlax-invoke spc 'InsertBlock p (strcat pat "\\" dwg) 1. 1. 1. 0.)
                      )
                    )
                  )
                )
              )
            )
          )
        )
        (/= 1 dcf)
      )
      (prompt "\nUser cancelled or terminated the dialog.")
    )
    ( '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114) )
  )
  (*error* nil) (princ) 
)

I had to study your suggestion, since I don't have much experience on working with external drawings or ODBX.

Maybe you guys could learn something new from the above code (although I used many @Lee Mac-ish techniques as always).

 

Edited by Grrr
Link to comment
Share on other sites

32 minutes ago, mstg007 said:

that is crazy. That's neat. Just browse to the folder and then it lists all the drawings. Select which ones and done

 

 

Have written a couple of folder mapping insert utilities in the past but haven't enabled them for multiple selection / insertion and I don't think I will. Well , now I come to think about it , I have one but it doesn't insert blocks as such but xref's so I can built a plot plan from our site for one or more plants and also add underground data like sewer , water , electricity etc. Anywayz, point is , every xref has the same origin point (0,0,0) so every building or underground system falls exactly into place. Are you doing something similar or are you building a model , like a chair for example , and then you can add an arm rest or a back rest as an option? All routines in this post allways insert at the same insertion point.

 

gr. Rlx

Link to comment
Share on other sites

Rethinking a list_box tile would be more suitable for this task, and then thought about Lee's Get Files Dialog that would make this task a cake of pieces. :D

But anyway just wanted to practice, thats why it uses toggles (and also per OP's request).

 

BTW corrected the code a bit - removed the temporary file creation outside the loop, else one will get a bunch of temporary .dcl files in his temp folder.

Don't know if thats default for everyone, but for me they are created in here:

(strcat "C:\\Users\\" (getenv "username") "\\AppData\\Local\\Temp")

 

Link to comment
Share on other sites

2 minutes ago, Grrr said:

Rethinking a list_box tile would be more suitable for this task, and then thought about Lee's Get Files Dialog that would make this task a cake of pieces. :D

But anyway just wanted to practice, thats why it uses toggles (and also per OP's request).

 

BTW corrected the code a bit - removed the temporary file creation outside the loop, else one will get a bunch of temporary .dcl files in his temp folder.

Don't know if thats default for everyone, but for me they are created in here:


(strcat "C:\\Users\\" (getenv "username") "\\AppData\\Local\\Temp")

 

 

well to be honest , while Lee's code may or may not be more practical, your dialog looks more attractive 🤫

 

🐉

 

Link to comment
Share on other sites

5 minutes ago, rlx said:

 

well to be honest , while Lee's code may or may not be more practical, your dialog looks more attractive 🤫

 

🐉

 

 

Thanks rlx, that means alot to me (knowing your super-advanced DCL work).

:beer:

I had in mind a small fixer-upper, like to fill in the last generated column with spacer tiles, so the toggles in there, won't be spreaded along the column's height, till its bottom.

The other thing was to check for the "unable to display the dialog, its too large" error, and to attempt to redisplay it with the last assigned items per column value.

But unfortunately I don't have spare time for this, already wasted enough...

Link to comment
Share on other sites

4 minutes ago, Grrr said:

 

Thanks rlx, that means alot to me (knowing your super-advanced DCL work).

:beer:

I had in mind a small fixer-upper, like to fill in the last generated column with spacer tiles, so the toggles in there, won't be spreaded along the column's height, till its bottom.

The other thing was to check for the "unable to display the dialog, its too large" error, and to attempt to redisplay it with the last assigned items per column value.

But unfortunately I don't have spare time for this, already wasted enough...

 

yeah same here, one could spent a lifetime solving other peoples problems / challenges ...

Link to comment
Share on other sites

Ok back to me and the comment about the big daddy of lisp has left the building. Today we had a new employee set up his Autocad using all our standard stuff and hey the auto plot routines do not work !!

 

A baffled moment 8 others sitting around him all work I am 5' away. 

 

Well it turns out our IT is up to its tricks again, when we added the printers to his PC, IT has decided to subtly change the server name even though the install says pick the correct printer ID. As the plot routines are hard coded for a certain printer no go. Luckily I have added around 10 new users on another floor they have different printers so use a cond to check which floor the user is on, the new guy is set as on the roof, we have 5 floors. :lol: But it shows some of the old fashioned stuff still works every time.

Link to comment
Share on other sites

3 minutes ago, BIGAL said:

Ok back to me and the comment about the big daddy of lisp has left the building. Today we had a new employee set up his Autocad using all our standard stuff and hey the auto plot routines do not work !!

 

A baffled moment 8 others sitting around him all work I am 5' away. 

 

Well it turns out our IT is up to its tricks again, when we added the printers to his PC, IT has decided to subtly change the server name even though the install says pick the correct printer ID. As the plot routines are hard coded for a certain printer no go. Luckily I have added around 10 new users on another floor they have different printers so use a cond to check which floor the user is on, the new guy is set as on the roof, we have 5 floors. :lol: But it shows some of the old fashioned stuff still works every time.

 

Haha, this 'proves' my point exactly :P , just kiss : keep it simple stupid :lol: 

although I must admit I had the same issue and my solution was to create a dialog with a list of available printers so if a user has changed the name of a printer it shows his or her personal list and if the printer wasn't installed you simply can't select it. Hope your company pays you enough BIGAL :xmas:

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...