Autogenerate Attribute callout with LISP

Autogenerate Attribute callout with LISP

Kyle.para
Advocate Advocate
3,975 Views
33 Replies
Message 1 of 34

Autogenerate Attribute callout with LISP

Kyle.para
Advocate
Advocate

Hi

 

I have a bunch of callouts setup as attributes inside of blocks.

I need to auto generate numbers usually 1 - 50 from either left to right or right to left depending on the drawing.

 

I also need a separate LISP that will auto generate letters in the same fashion but also on the same drawing.

 

Will I have to pick all the blocks or can it be auto generated some how?

If it can I'm guessing I would have to distinguish between the attributes I need numbered and the attributes I need lettered some how?

 

Thanks,

0 Likes
Accepted solutions (4)
3,976 Views
33 Replies
Replies (33)
Message 21 of 34

john.uhden
Mentor
Mentor

Yes, I remain unemployed.

 

Your response was as clear New England clam chowder.

 

Just how are you going to "reserve" "1" and "2?"  Will they already exist before running this program?  Will they use any of the attributes tags we have developed, or will they have their own unique tag?  Are "1" and "2" to remain constant?

 

Without those answers you are stuck with what you've got.

John F. Uhden

0 Likes
Message 22 of 34

Kyle.para
Advocate
Advocate
I would like them to have the same tag if possible. But if that's not
possible then a different tag # is fine. The name of the blocks are
conveyor and correlator if that helps.

They will always be 1&2. The problem is that sometimes we place stuff
farther to the left or farther to the right. But I need those two pieces to
remain 1 & 2.

Thanks, Kyle
0 Likes
Message 23 of 34

john.uhden
Mentor
Mentor
Accepted solution

Well, here we go again.

The only thing I could think of doing is to ignore (leave alone) any existing #Atts that already have a value of "1", "2", "01", or "02" no matter their left or right location.  This means that if you run the program before there are any 1s or 2s, then all the #Atts will get labeled starting at "03."  So if you want certain ones to be 1 and 2, then run the program again after you have set them.

 

; AutoAtt.lsp for Kyle.Para by John Uhden (2-11-17), rev. (02-24-17)
;; Program labels attributes both numerically and alphabetically (like Excel columns)
;; sorted from either Left to right or Right to left based on the WCS.
;; Attribute tags ending in "#" are labeled numerically,
;; Attribute tags ending in "$" are labeled alphabetically.
;; Attribute tags ending in "%" are labeled alphabetically.
;; Many many thanks to Doug Broad for contributing the ntos function which translates
;; integers to Excel-like strings.
;; Labels start at 1 ("A") and can continue into the hundrdes of thousands.
;; rev (02-26-17) to not change any #Atts having "reserved" values of "1", "2", "01", or "02"
(defun c:AutoAtt ( / *error* vars <> Atts n# n$ n% #Atts $Atts %Atts ntos itos)
  (princ "\nAutoAtt v1.2 (02-24-17)")
  (vl-load-com)
  (defun *error* (err)
    (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
    (vla-endundomark *doc*)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho")))
  (mapcar '(lambda (x)(setvar (car x) 0))  vars)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (setq n# 2 n$ 0 n% 0) ;; Kyle wants to reserve values "1" and "2" (02-24-17)
  ;;===================================================================
  ;; By Doug Broad (2-10-17)
    ;; Sorry @john.uhden.  Been busy with a Statics and Strengths class today.
    ;; Here is one that works with a base 25, using 0 as A and 25 as Z.
    ;; Convert base 10 to letters
    ;; 0 = a to 25 = z for each digit.
    ;; Works for 0 to (- (expt 26 7) 1) integer maximum
    ;; JFU did Cooperial compaction and adjusted n by one
    (defun ntos (n)
      (if (< (setq n (1- n)) 26)
        (chr (+ 65 n))
        (strcat (ntos (/ n 26))(chr (+ 65 (rem n 26))))
      )
  )
  ;; Added itos (02-24-17) so that numbers from 3 to 9
  ;; are preceded by a "0", as in "05"
  (defun itos (n)
    (if (>= 3 n 9)(strcat "0" (itoa n))(itoa n))
  )
  (initget "Left Right")
  (setq <> (getkword "\nSort from [<Left to right>/Right to left]: "))
  (if (or (not <>)(= <> "Left"))
    (setq <> <)
    (setq <> >)
  )
  (if (ssget "x" '((0 . "INSERT")(66 . 1)))
    (vlax-for Object (vla-get-ActiveSelectionSet *doc*)
      (and
        (= (vlax-get Object 'HasAttributes) -1)
        (foreach Att
            (vlax-invoke Object 'GetAttributes)
            (setq Atts (cons Att Atts))
        )
      )
    )
    (prompt "\nNo blocks with attributes in drawing")
  )
  (foreach Att Atts
    (cond
      ((wcmatch (vlax-get Att 'Tagstring) "*`#")
        (if (not (member (vlax-get Att 'Textstring) '("1" "2" "01" "02"))) ;; added (02-26-17)
          (setq #Atts (cons Att #Atts))
        )
      )
      ((wcmatch (vlax-get Att 'Tagstring) "*$")
        (setq $Atts (cons Att $Atts))
      )
      ((wcmatch (vlax-get Att 'Tagstring) "*%")
        (setq %Atts (cons Att %Atts))
      ) 
    )
  )
  (princ (strcat "\nLength of #Atts = " (itoa (length #atts))))
  (princ (strcat "\nLength of $Atts = " (itoa (length $atts))))
  (princ (strcat "\nLength of %Atts = " (itoa (length %atts))))
  (setq #Atts (vl-sort #Atts '(lambda (a b)(<> (car (vlax-get a 'InsertionPoint))(car (vlax-get b 'InsertionPoint))))))
  (setq $Atts (vl-sort $Atts '(lambda (a b)(<> (car (vlax-get a 'InsertionPoint))(car (vlax-get b 'InsertionPoint))))))
  (setq %Atts (vl-sort %Atts '(lambda (a b)(<> (car (vlax-get a 'InsertionPoint))(car (vlax-get b 'InsertionPoint))))))
  (foreach Att #Atts (vlax-put Att 'Textstring (itos (setq n# (1+ n#)))) (vla-update Att))
  (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n$ (1+ n$)))) (vla-update Att))
  (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n% (1+ n%)))) (vla-update Att))
  (*error* nil)
)
(defun c:AA ()(c:AutoAtt))

John F. Uhden

Message 24 of 34

Kyle.para
Advocate
Advocate

The 01 & 02 is being reserved and works perfect.  The only issue is the 03-09 are still being inserted as 3-9 for some reason.

Thanks, Kyle

0 Likes
Message 25 of 34

john.uhden
Mentor
Mentor
Accepted solution

re: 3-9

 

Oops.  That's my mistake.

 

Change:

(defun itos (n)
    (if (>= 3 n 9)(strcat "0" (itoa n))(itoa n))
)

to:

(defun itos (n)
    (if (<= 3 n 9)(strcat "0" (itoa n))(itoa n))
)

Please let me know if it works okay (after the correction).

John F. Uhden

Message 26 of 34

Kyle.para
Advocate
Advocate

Works fantastic now, thanks.

 

Do you know how I can load this every I start a drawing? Or do I have to load it every time?

0 Likes
Message 27 of 34

john.uhden
Mentor
Mentor

That's what acaddoc.lsp is for.  AutoCAD loads it (the first one it finds in its search path) every time you open or start a new drawing.

 

So just add to (or create) the file..

 

(load "<path>/AutoAtt.lsp")(princ)

 

The best way to do this is to create your own special folder and add it to the top of the search path in the "OPTIONS" command.

That way you need not include the <path> above.

 

But, see if you already have an acaddoc.lsp file by entering the following at the command prompt:

(findfile "acaddoc.lsp")

If AutoCAD finds the file in its search path, then it will return the full path, otherwise it will return nil.

There may be multiple acaddoc.lsp files in your installation, but AutoCAD will report and load only the first one it finds.

John F. Uhden

0 Likes
Message 28 of 34

Kyle.para
Advocate
Advocate

Thanks John, I understand now.  Something else I need to learn about.  I like that is can set system variables and stuff to.  Very interesting.

0 Likes
Message 29 of 34

john.uhden
Mentor
Mentor

YAY for you!!  And thanks for the accolade too.

John F. Uhden

0 Likes
Message 30 of 34

Kyle.para
Advocate
Advocate

@john.uhden

 

Hi John,

 

It has been awhile, but I have just recently had the opportunity to try the code with a % sign thrown in.

 

However, to much avail it's not working as expected.  Hope you are around to help me figure out what the problem might be.

 

Thanks, Kyle

0 Likes
Message 31 of 34

john.uhden
Mentor
Mentor
Bummer. I thought we had everything covered. What are the exact symptoms
of failure? The % character shouldn't offer any problems, unless they have
added it as a wildcard character since 2002.
Maybe you should post a sample .DWG saved back to 2002. Also post your
version of our code; maybe there's something in there that needs a little
tweak.

My apologies for my delayed response time. I actually have a little flood
hazard area computations to finish to satisfy NJDEP, and my wife has been
in the hospital with various unresolved problems (heart and liver), and my
youngest daughter (with a one-year-old) is facing a divorce from her
cheating husband.

John F. Uhden

0 Likes
Message 32 of 34

Kyle.para
Advocate
Advocate

@john.uhden

 

Yeah I thought we had her to, but I guess I never tried to actually use it with a % sign. 

Here's the code I am currently using and a test file saved as 2000 dwg

 

; AutoAtt.lsp for Kyle.Para by John Uhden (2-11-17), rev. (02-24-17)
;; Program labels attributes both numerically and alphabetically (like Excel columns)
;; sorted from either Left to right or Right to left based on the WCS.
;; Attribute tags ending in "#" are labeled numerically,
;; Attribute tags ending in "$" are labeled alphabetically.
;; Attribute tags ending in "%" are labeled alphabetically.
;; Many many thanks to Doug Broad for contributing the ntos function which translates
;; integers to Excel-like strings.
;; Labels start at 1 ("A") and can continue into the hundrdes of thousands.
;; rev (02-26-17) to not change any #Atts having "reserved" values of "1", "2", "01", or "02"
(defun c:AutoAtt ( / *error* vars <> Atts n# n$ n% #Atts $Atts %Atts ntos itos)
  (princ "\nAutoAtt v1.2 (02-24-17)")
  (vl-load-com)
  (defun *error* (err)
    (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
    (vla-endundomark *doc*)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho")))
  (mapcar '(lambda (x)(setvar (car x) 0))  vars)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (setq n# 2 n$ 0 n% 0) ;; Kyle wants to reserve values "1" and "2" (02-24-17)
  ;;===================================================================
  ;; By Doug Broad (2-10-17)
    ;; Sorry @john.uhden.  Been busy with a Statics and Strengths class today.
    ;; Here is one that works with a base 25, using 0 as A and 25 as Z.
    ;; Convert base 10 to letters
    ;; 0 = a to 25 = z for each digit.
    ;; Works for 0 to (- (expt 26 7) 1) integer maximum
    ;; JFU did Cooperial compaction and adjusted n by one
    (defun ntos (n)
      (if (< (setq n (1- n)) 26)
        (chr (+ 65 n))
        (strcat (ntos (/ n 26))(chr (+ 65 (rem n 26))))
      )
  )
  ;; Added itos (02-24-17) so that numbers from 3 to 9
  ;; are preceded by a "0", as in "05"
(defun itos (n)
    (if (<= 3 n 9)(strcat "0" (itoa n))(itoa n))
)
  (initget "Left Right")
  (setq <> (getkword "\nSort from [<Left to right>/Right to left]: "))
  (if (or (not <>)(= <> "Left"))
    (setq <> <)
    (setq <> >)
  )
  (if (ssget "x" '((0 . "INSERT")(66 . 1)))
    (vlax-for Object (vla-get-ActiveSelectionSet *doc*)
      (and
        (= (vlax-get Object 'HasAttributes) -1)
        (foreach Att
            (vlax-invoke Object 'GetAttributes)
            (setq Atts (cons Att Atts))
        )
      )
    )
    (prompt "\nNo blocks with attributes in drawing")
  )
  (foreach Att Atts
    (cond
      ((wcmatch (vlax-get Att 'Tagstring) "*`#")
        (if (not (member (vlax-get Att 'Textstring) '("1" "2" "01" "02"))) ;; added (02-26-17)
          (setq #Atts (cons Att #Atts))
        )
      )
      ((wcmatch (vlax-get Att 'Tagstring) "*$")
        (setq $Atts (cons Att $Atts))
      )
      ((wcmatch (vlax-get Att 'Tagstring) "*%")
        (setq %Atts (cons Att %Atts))
      ) 
    )
  )
  (princ (strcat "\nLength of #Atts = " (itoa (length #atts))))
  (princ (strcat "\nLength of $Atts = " (itoa (length $atts))))
  (princ (strcat "\nLength of %Atts = " (itoa (length %atts))))
  (setq #Atts (vl-sort #Atts '(lambda (a b)(<> (car (vlax-get a 'InsertionPoint))(car (vlax-get b 'InsertionPoint))))))
  (setq $Atts (vl-sort $Atts '(lambda (a b)(<> (car (vlax-get a 'InsertionPoint))(car (vlax-get b 'InsertionPoint))))))
  (setq %Atts (vl-sort %Atts '(lambda (a b)(<> (car (vlax-get a 'InsertionPoint))(car (vlax-get b 'InsertionPoint))))))
  (foreach Att #Atts (vlax-put Att 'Textstring (itos (setq n# (1+ n#)))) (vla-update Att))
  (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n$ (1+ n$)))) (vla-update Att))
  (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n% (1+ n%)))) (vla-update Att))
  (*error* nil)
)
(defun c:AA ()(c:AutoAtt))

 

I completely understand your reason for not getting back to me right away sounds like you have a lot to deal with at the moment.  Are you guys getting flooded in New Jersey too? It has been a bad year for that in Ontario as well.  Sorry to hear about your wife I hope she gets better soon and also for your daughters struggles, that's tough.

0 Likes
Message 33 of 34

john.uhden
Mentor
Mentor
Accepted solution

That was easy.  We had a mistake at the very end...

 

  (foreach Att #Atts (vlax-put Att 'Textstring (itos (setq n# (1+ n#)))) (vla-update Att))
  (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n$ (1+ n$)))) (vla-update Att))
  (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n% (1+ n%)))) (vla-update Att))

;; Change $ (above in red) to % (below in blue). We were doing the $Atts twice.
(foreach Att #Atts (vlax-put Att 'Textstring (itos (setq n# (1+ n#)))) (vla-update Att)) (foreach Att $Atts (vlax-put Att 'Textstring (ntos (setq n$ (1+ n$)))) (vla-update Att)) (foreach Att %Atts (vlax-put Att 'Textstring (ntos (setq n% (1+ n%)))) (vla-update Att))

I see that the %Atts are alpha characters.  If you want them to be numeric characters then change (ntos ...) to (itos ...) just like the #Atts

John F. Uhden

Message 34 of 34

Kyle.para
Advocate
Advocate

Works great thanks a lot John. Glad that was an easy one for a change!

0 Likes