Jump to content

Part number Balloon numbering


cadmando2

Recommended Posts

I am using AutoCAD electrical 2014 and having issues with the bugs in it. Beside that I couldn’t get the balloon tagging command to work in AutoCAD electrical

I just decided to use the Mleader command with balloon block with attributes on the end of the leader line and per set arrow size and block scale. It is time consuming entering the number each time. There used to be a lisp routine that would incremental numbering. But I can’t find it on-line. Does anyone know of a good lisp routine?

Would be nice to select the part “Block with attributes” and link the balloon tag so that I could be exported out to text file or Excel spreadsheet BOM list.

Link to comment
Share on other sites

There are heaps I did a recent version it can use 1 A or a and auto increment its at work

 

anyway an oldy you need a block called setout_pt with 1 attribute.

 

; pit bubble creation with auto increment
(defun trap (errmsg)
  (prompt "\nAn error has occured.")
  (command "undo" "b")
  (setvar "osmode" os)
  (setq *error* temperr)
)

(defun c:SETOUTPT (/ ang att el el1 en en1 index n newpno os pt1 pt2 pt3 ss1 t t1 temperr testpno scale)
  (setvar "cmdecho" 0)
  (setq temperr *error*)
  (setq *error* trap)
  (setq scale (getvar "dimscale"))  
  (setq os (getvar "osmode"))
  (command "undo" "m")
  (if (= pno nil) (setq pno 1))
  (prompt "\nEnter Setout Point No.<")(prin1 pno)(prompt ">:")
  (setq newpno (getint))
  (if (= newpno nil) (setq newpno pno))
  (setq ss1 (ssget "x" '((2 . "setout_point"))))
  (if (/= ss1 nil)
     (progn
        (setq n (sslength ss1))
        (setq t 1)
        (while t
           (setq index 0)
           (setq t1 1)
           (while t1
              (setq en (ssname ss1 index))
              (setq index (+ index 1))
              (setq el (entget en))
              (setq en1 (entnext en))
              (setq el1 (entget en1))
              (setq att (cdr (assoc 1 el1)))
              (setq testpno (itoa newpno))
              (if (= att testpno)
                 (progn
                    (prompt "\nSetout Point No.")(prin1 newpno)(prompt " already exists.")
                    (prompt "\nEnter new number:")
                    (setq newpno (getint))
                    (setq t1 nil)
                 );progn  
                 ;else
                 (if (= index n)
                    (progn
                       (setq t nil)
                       (setq t1 nil)
                    );progn
                 );if = index
              );if = att
           );while t1
        );while t
     );progn
  );if ss1 /= nil
  (setq pt1 (getpoint "\nPick setout point: "))
  (prompt "\nPoint for circle: ")
;   (command "insert" "*setoutpt" "0,0" "" "")
  (command "insert" "setout_point_no" pause "" "" "" newpno)
  (setq pt2 (getvar "lastpoint"))
  (command "insert" "setout_point" pt1 scale "" "" newpno)
  (setq ang (angle pt1 pt2))
  (setq pt3 (polar pt2 (- ang pi) (* scale 4.5)))
  (command "osmode" 0) 
  (command "line" pt1 pt3 "")
  (setq pno (+ newpno 1))
  (setvar "osmode" os)
  (setq *error* temperr)
  (princ)
)

Link to comment
Share on other sites

newer version makes blocks etc and you can use 1 or A or a

 

; bubble pt num
; BY ALAN H AUG 2014

(defun make_circle ()
 (entmake (list (cons 0 "CIRCLE")
 (cons 8 "0") ; layr
 (cons 10 (list 0 0 0)) ; cen pt
 (cons 40 3.25)     ; rad
 (cons 210 (list 0 0 1))
 (cons 62 256) 
 (cons 39 0)
 (cons 6 "BYLAYER")
  )
 )
) ; DEFUN

(defun make_sq ()
; 4 cnr points
 (setq   vertexList
 (list
 (list -3.25 -3.25 0.)
 (list 3.25 -3.25 0.)
 (list 3.25 3.25 0.)
 (list -3.25 3.25 0.)
 ))
 (entmake
   (append 
   (list '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   (cons 90 (length vertexList))
   (cons 70 1)   ; 1 closed : 0 open
   (cons 8 "0")
   (cons 38 0.0)
   (cons 210 (list 0.0 0.0 1.0))
   )
   (mapcar '(lambda (pt) (cons 10 pt)) vertexList)
   )
 ) ; entmake
) ; defun

(defun Make_bubble ( )

 (entmake (list (cons 0 "BLOCK")
   (cons 2 Blkname)
   (cons 70 2)
   (cons 10 (list 0 0 0))
   (CONS 8 "0")
 ))

 (if (= resp "C")
 (make_circle)
 (make_sq)
 )

 (entmake (list (cons 0 "ATTDEF")
      (cons 8 "0")
      (cons 10 (list 0 0 0))
      (cons 1 "1")    ; default value
      (cons 2 blkname) ; nblock name
      (cons 3 "Ptnum") ; tag name
      (cons 6 "BYLAYER")
      (cons 7 "STANDARD")             ;text style
      (cons 8 "0")    ; layer
      (cons 11 (list 0.0 0.0 0.0)) ; text insert pt
      (cons 39 0)
      (cons 40 3.5)           ; text height
      (cons 41 1)     ; X scale
      (cons 50 0)     ; Text rotation
      (cons 51 0)     ; Oblique angle
      (cons 62 256)          ; by layer color 
      (cons 70 0)
      (cons 71 0)     ;Text gen flag
      (cons 72 1)     ; Text Justify hor 1 center
      (cons 73 0)     ; field length
      (cons 74 2)     ; Text Justify ver 2 center
      (cons 210 (list 0 0 1))
 ))

 (entmake (list (cons 0 "ENDBLK")))
(command "erase" "L" "") ; do not need linework etc so erase
 (princ)

)

(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
 (if (= 1 (getvar 'cvport))
 (setq sc 1.0)
 (setq sc (/ 1000.0 (getreal "\nEnter plotting scale")))
 )

 (setq oldsnap (getvar "osmode"))
 (setvar "textstyle" "standard")

 (setq ptnum (getstring "\nEnter Pt Number or alpha"))
 (setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
 (if (< chrnum 58)
 (setq ptnumb (atof ptnum));convert back to a number 
 )


(while (setq pt (getpoint "\Pick end of line Enter to exit"))
   (setq pt2 (polar pt (/ pi 2.0) 3.25))
   (setvar "osmode" 0)

   (if        (< chrnum 58)
   (progn
   (command "-insert" blkname pt sc  "" 0 (rtos ptnumb 2 0))
   (setq ptnumb (+ ptnumb 1))
   )
   (progn 
   (command "-insert" blkname pt sc "" 0 (chr chrnum))
   (setq chrnum (+ chrnum 1))
   )
   )
   (command "move" "L" "" pt pt2)
   (setvar "osmode" 1)
)

(setvar "osmode" oldsnap)
(princ)
)       ; end defun
;;;;;; 
; program starts here checking 
(alert "Type Bub to repeat\nYou can do alpha's or numbers\nSquare or circles")
(initget 6 "S s C c")
(setq resp (strcase (Getkword "\nDo you want Circle or Square C or S <C> ")))
(if (or (= resp "C") (= resp nil))
 (setq blkname "SETOUT_POINT_NO")
 (setq blkname "SETOUT_POINT_NOSQ")
)
(if (/= (tblsearch "BLOCK" blkname) NIL)
(PRINC "FOUND")    ; block exists
(Make_bubble)
)

(C:BUB)
(princ)

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...