Jump to content

Balloning based on a multileader

elfert

By elfert
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

elfert Enthusiast

elfert

Posted
Posted

Hello CAD members! :cry:

 

I am trying to make a lisp routine that can draw a item number based on a multileader. But after i make the routine check if there specific layer on the drawing i make the routine like this that it has to make it if is not. But after this i want it to check if the the multileader style is on the drawing. If is not then it have to import from a template or make it by itself if i tel the program what variables i want in the multileaderstyle. If is on the drawing then it has to continue with the routine.

 

Here is the routine:

 

;;;item2011.LSP inserts a multileader item number. 

(defun MYERROR (S)                    ;;Error catching program
  (if (/= S "\nFunction cancelled" )
  (prompt "\nEnding itemnumber routine..." ) )
  (setvar "OSMODE" gammelosnap)
  (setvar "CMDECHO" gammelcmdecho)
  (command "._undo" "end")
  (command "-layer" "s" glag"" )
  (setq *ERROR* OLDERR )
 (princ) 
)
(defun c:ballon ()
;;Getting current Layer
(setq glag   (getvar "clayer"))
;;Getting current cmdecho mode
(setq gammelcmdecho (getvar "cmdecho"))
;;Getting current osmode
(setq gammelosnap (getvar "osmode"))
;;setting osmode zero
(setvar "OSMODE" 0)
;;setting cmdecho zero
(setvar "cmdecho" 0)
(setq *ERROR* MYERROR )
(command "._undo" "begin")
;;Setting up Layer
(if (not (tblsearch "LAYER" "AM_5"))
(Command "-layer" "n" "AM_5" "c" "3" "AM_5" "s" "AM_5" "P" "P" "AM_5" "")
(setvar "clayer" "AM_5"))
;;Set current mleaderstyle to item
(command "CMLEADERSTYLE" "item")
;;Getting tagnumber
(initget 1)
(setq POSNR (getint "\nEnter tagnumber.: "))
;;Getting points for subject to tag and position tagnumber
(while (setq P1 (getpoint "\nSubject : "))
(setvar "OSMODE" 512)   
(setq P2 (getpoint "\nPlace of Ballon.: "))
(setvar "OSMODE" 0)  
;;Drawing the mleader
(command "mleader" P1 P2 POSNR"")
;;Adding 1 Item number the next item number
(setq POSNR (1+ POSNR))
)
(redraw)
;;setting setting up old layer 
(command "-layer" "s" glag"" )
;;setting osmode to past
(setvar "OSMODE" gammelosnap) 
;;setting CMDECHO to past
(setvar "CMDECHO" gammelcmdecho)
)

(princ)
 (prompt "\nEnter ballon to insert ballon. Right click for jumbing of rutine.")
(princ)

So what do i have to put in the routine?

 

Thanx in advance

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted 

 
(if (not (tblsearch "LAYER" "AM_5"))
(Command "-layer" [b][color=blue]"n"[/color][/b] "AM_5" "c" "3" "AM_5" "s" "AM_5" "P" "P" "AM_5" "")
[color=sienna](setvar "clayer" "AM_5"));<--- no need for this if you use "make" instead of "New"[/color]

 

 
(command "CMLEADERSTYLE" "item");<---- will crash if i[i]tem[/i] is nil

 

to test if existing use this

 

 
[color=blue](if (vl-catch-all-error-p[/color]
[color=blue]  (vl-catch-all-apply 'setvar (list "CMLEADERSTYLE" "item"))[/color]
[color=blue]  )[/color]
[color=blue](create/import your mleader style)[/color]
[color=blue])[/color]

 

this:

 (initget [b][color=sienna]1[/color][/b])
(setq POSNR (getint "\nEnter tagnumber.: "))
(while (setq P1 (getpoint "\nSubject : "))
 (setvar "OSMODE" 512)
 (setq P2 (getpoint "\nPlace of Ballon.: "))
[color=sienna][b](setvar "OSMODE" 0)[/b][/color]
 (command "mleader" P1 P2 [color=sienna][b]POSNR "")[/b][/color]
 (setq POSNR (1+ POSNR))
 )

 

should be

(initget [color=blue][b]7[/b][/color])
(setq POSNR (getint "\nEnter tagnumber.: "))
(while (setq P1 (getpoint "\nSubject : "))
(setvar "OSMODE" 512)   
(setq P2 (getpoint [color=blue][b]p1 [/b][/color]"\nPlace of Ballon.: "))
(command "mleader" [color=blue][b]"_non"[/b][/color] P1 [color=blue][b]"_non"[/b][/color] P2 [color=blue][b](itoa POSNR))[/b][/color]
(setq POSNR (1+ POSNR))
)

...
(setvar "OSMODE" 0)

 

Hope this helps

 

BTW: make sure (vl-load-com) is loaded

Link to comment
Share on other sites
alanjt Grand Master

alanjt

Posted
Posted

You can easily create your own style (insert from template) and just use the Circle block provided (inserted once style is created using block content and choosing Circle).

 

I'll leave the style and layer check to you, but this coding should help to emulate the actual workings of the MLeader command...

 

(defun c:BubbleInc (/ *error* cmd pt)

 (defun *error* (msg)
   (and cmd (setvar 'CMDECHO cmd))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (setq cmd (getvar 'CMDECHO))
 (setvar 'CMDECHO 0)

 (initget 6)
 (setq *BI:Inc* (cond ((getint (strcat "\nSpecify starting number <"
                                       (itoa (cond (*BI:Inc*)
                                                   ((setq *BI:Inc* 1))
                                             )
                                       )
                                       ">: "
                               )
                       )
                      )
                      (*BI:Inc*)
                )
 )

 (while (setq pt (getpoint "\nSpecify starting point: "))
   (progn (princ "\nSpecify other point: ")
          (command "_.mleader" "_non" pt PAUSE)
          (if (eq (logand 1 (getvar 'CMDACTIVE)) 1)
            (progn (command *BI:Inc*) (setq *BI:Inc* (1+ *BI:Inc*)))
          )
   )
 )

 (*error* nil)
 (princ)
)

 

I've actually been meaning to do one of these myself (been using a crappy block). I'll tweak when I get back in the office and re-post.

Link to comment
Share on other sites
alanjt Grand Master

alanjt

Posted
Posted

Quick mod to add Undo option. Also added undo wrapping using VL since it's a lot cleaner than (command "_.undo" ..).

 

(defun c:BubbleInc (/ *error* cmd pt lst)

 (vl-load-com)

 (defun *error* (msg)
   (and cmd (setvar 'CMDECHO cmd))
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (vla-startundomark
   (cond (*AcadDoc*)
         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
   )
 )

 (setq cmd (getvar 'CMDECHO))
 (setvar 'CMDECHO 0)

 (initget 6)
 (setq *BI:Inc* (cond ((getint (strcat "\nSpecify starting number <"
                                       (itoa (cond (*BI:Inc*)
                                                   ((setq *BI:Inc* 1))
                                             )
                                       )
                                       ">: "
                               )
                       )
                      )
                      (*BI:Inc*)
                )
 )

 (while (if lst
          (progn (initget "Undo") (setq pt (getpoint "\nSpecify starting point [undo]: ")))
          (setq pt (getpoint "\nSpecify starting point: "))
        )
   (if (eq pt "Undo")
     (progn (entdel (car lst)) (setq lst (cdr lst)) (setq *BI:Inc* (1- *BI:Inc*)))
     (progn
       (princ "\nSpecify other point: ")
       (vl-cmdf "_.mleader" "_non" pt PAUSE)
       (if (eq (logand 1 (getvar 'CMDACTIVE)) 1)
         (progn (vl-cmdf *BI:Inc*) (setq *BI:Inc* (1+ *BI:Inc*)) (setq lst (cons (entlast) lst)))
       )
     )
   )
 )

 (*error* nil)
 (princ)
)

Link to comment
Share on other sites
alanjt Grand Master

alanjt

Posted
Posted

Ehh, not sure why I was thinking it was a lot more work...

 

(defun c:BI (/ *error* cmd sty pt lst)
 ;; Bubble Increment ("BUBBLE" MLeader style required)
 ;; Alan J. Thompson, 12.04.11

 (vl-load-com)

 (defun *error* (msg)
   (and cmd (setvar 'CMDECHO cmd))
   (and sty (setvar 'CMLEADERSTYLE sty))
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (vla-startundomark
   (cond (*AcadDoc*)
         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
   )
 )

 (setq cmd (getvar 'CMDECHO)
       sty (getvar 'CMLEADERSTYLE)
 )
 (setvar 'CMDECHO 0)

 (cond ((not (vl-catch-all-error-p (vl-catch-all-apply 'setvar '(CMLEADERSTYLE "BUBBLE"))))
        (initget 6)
        (setq *BI:Inc* (cond ((getint (strcat "\nSpecify starting number <"
                                              (itoa (cond (*BI:Inc*)
                                                          ((setq *BI:Inc* 1))
                                                    )
                                              )
                                              ">: "
                                      )
                              )
                             )
                             (*BI:Inc*)
                       )
        )

        (while (if lst
                 (progn (initget "Undo") (setq pt (getpoint "\nSpecify starting point [undo]: ")))
                 (setq pt (getpoint "\nSpecify starting point: "))
               )
          (if (eq pt "Undo")
            (progn (entdel (car lst)) (setq lst (cdr lst)) (setq *BI:Inc* (1- *BI:Inc*)))
            (progn
              (princ "\nSpecify other point: ")
              (vl-cmdf "_.mleader" "_non" pt PAUSE)
              (if (eq (logand 1 (getvar 'CMDACTIVE)) 1)
                (progn (vl-cmdf *BI:Inc*)
                       (setq *BI:Inc* (1+ *BI:Inc*))
                       (setq lst (cons (entlast) lst))
                )
              )
            )
          )
        )
       )
       ((alert "BUBBLE multileader style not loaded!"))
 )

 (*error* nil)
 (princ)
)

Link to comment
Share on other sites
alanjt Grand Master

alanjt

Posted
Posted

Nice and generic. Will place on designated layer (if valid) or current layer. MLeader style existence is still on the user - I insert all my styles at the beginning of each startup, so I'm leaving it at that (mod how/if you like)...

 

(defun c:BI (/ *error* _toLayer style layer cmd sty pt lst)
 ;; Bubble Increment (MLeader style required)
 ;; Alan J. Thompson, 12.04.11

 (setq style "BUBBLE" ; MLeader style (with single attribute block)
       layer "BUBBLE" ; layer to place MLeader objects on (optional, nil for current layer)
 )

 (vl-load-com)

 (defun *error* (msg)
   (and cmd (setvar 'CMDECHO cmd))
   (and sty (setvar 'CMLEADERSTYLE sty))
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (setq _toLayer
        (eval
          (list
            'lambda
            '(e / d)
            (if (and layer (snvalid layer))
              '(entupd
                (cdr (assoc -1 (entmod (subst (cons 8 layer) (assoc 8 (setq d (entget e))) d))))
               )
            )
          )
        )
 )

 (vla-startundomark
   (cond (*AcadDoc*)
         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
   )
 )

 (setq cmd (getvar 'CMDECHO)
       sty (getvar 'CMLEADERSTYLE)
 )
 (setvar 'CMDECHO 0)

 (cond ((not (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list 'CMLEADERSTYLE style))))
        (initget 6)
        (setq *BI:Inc* (cond ((getint (strcat "\nSpecify starting number <"
                                              (itoa (cond (*BI:Inc*)
                                                          ((setq *BI:Inc* 1))
                                                    )
                                              )
                                              ">: "
                                      )
                              )
                             )
                             (*BI:Inc*)
                       )
        )

        (while (if lst
                 (progn (initget "Undo") (setq pt (getpoint "\nSpecify starting point [undo]: ")))
                 (setq pt (getpoint "\nSpecify starting point: "))
               )
          (if (eq pt "Undo")
            (progn (entdel (car lst)) (setq *BI:Inc* (1- *BI:Inc*)) (setq lst (cdr lst)))
            (progn
              (princ "\nSpecify other point: ")
              (vl-cmdf "_.mleader" "_non" pt PAUSE)
              (if (eq (logand 1 (getvar 'CMDACTIVE)) 1)
                (progn (vl-cmdf *BI:Inc*)
                       (setq *BI:Inc* (1+ *BI:Inc*)
                             lst      (cons (entlast) lst)
                       )
                       (_toLayer (car lst))
                )
              )
            )
          )
        )
       )
       ((alert (strcat style " multileader style not loaded!")))
 )

 (*error* nil)
 (princ)
)

 

MLeader style:

mleaderstyle.png

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.

×
 Share
Go to topic listing
×
×
  • Create New...