Jump to content

Recommended Posts

Posted

Hello,

 

I'm relatively new to AutoLISP but understand the principles.

 

I'm trying to auto generate a number for individual trees that have already been plotted in another program and imported as a DXF.

 

I would like the autonumber to be an attribute so I can export the number and the X & Y data into a .CSV file, which I can then use elsewhere.

 

I can't work out if the auto generator will make a logical number sequence, or if the numbers will just appear randomly across the tree stock. In which case I might as well have a new block with autogenerated number and locate the blocks in the order I want them.

 

Any help would be very much appreciated.

 

Cheers, Alistair.

Posted

Hi Alistair,

 

A program could be used to number your trees, perhaps from left to right or top to bottom (or vice versa) etc. Would the tag name be the same for all the blocks?

 

Lee

Posted

Yes, the tag name would be the same for all the trees.

 

I find generally I would number the trees in a clockwise or anti-clockwise fashion.

 

Thanks for your help.

Posted

Hi Alistair,

 

Please try this function, it will incrementally number attributes sorting by Y-Coord in ascending order, as I wasn't quite sure what you meant by Clockwise? Clockwise around a central block?

 

Change the Tag Name as necessary (at the top).

 

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:AttNum [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] *error* MakeVariant Itemp MakeSelectionSet
                   DOC OBJ OBJECTLIST SS TAG UFLAG[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [i][color=#990099];; Lee Mac  ~  15.04.10[/color][/i]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tag [b][color=#a52a2a]"TAG1"[/color][/b][b][color=RED])[/color][/b] 

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] uFlag
     [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MakeVariant [b][color=RED]([/color][/b]data datatype[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vlax-make-variant[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vlax-safearray-fill[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vlax-make-safearray[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eval[/color][/b] datatype[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]length[/color][/b] data[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       data
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] Itemp [b][color=RED]([/color][/b]collection item [b][color=BLUE]/[/color][/b] result[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-error-p[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] result
                [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-apply[/color][/b]
                  [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vla-item[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] collection item[b][color=RED])[/color][/b]
                [b][color=RED])[/color][/b]
              [b][color=RED])[/color][/b]
            [b][color=RED])[/color][/b]
        [b][color=RED])[/color][/b]
     result
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MakeSelectionSet [b][color=RED]([/color][/b]ref [b][color=BLUE]/[/color][/b] SelSets SelSet[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] SelSet
         [b][color=RED]([/color][/b]itemp
           [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] SelSets
             [b][color=RED]([/color][/b][b][color=BLUE]vla-get-SelectionSets[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b]
               [b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
           ref
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     
     [b][color=RED]([/color][/b][b][color=BLUE]vla-delete[/color][/b] SelSet[b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vla-add[/color][/b] SelSets ref[b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *start
   [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b]
     [b][color=RED]([/color][/b]*start[b][color=RED])[/color][/b] [b][color=RED]([/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *start
   [b][color=RED]([/color][/b][b][color=BLUE]1-[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b]
       [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]getint[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\nSpecify Starting Number <"[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] *start[b][color=RED])[/color][/b] [b][color=#a52a2a]"> : "[/color][/b]
            [b][color=RED])[/color][/b]
          [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b]*start[b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]     

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Count[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss
           [b][color=RED]([/color][/b][b][color=BLUE]vla-get-PickFirstSelectionSet[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc
               [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b]
               [b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b]MakeSelectionSet [b][color=#a52a2a]"Tree_SS"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vla-SelectOnScreen[/color][/b] ss
       [b][color=RED]([/color][/b]MakeVariant [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] [b][color=#009900]66[/color][/b][b][color=RED])[/color][/b] [b][color=Blue]vlax-vbInteger[/color][color=RED])[/color][/b]
       [b][color=RED]([/color][/b]MakeVariant [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#a52a2a]"INSERT"[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b] [b][color=Blue]vlax-vbVariant[/color][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Count[/color][/b] ss[b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] UFlag
       [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] doc[b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] obj ss
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ObjectList
         [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] obj
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-safearray->list[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]vlax-variant-value[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-property[/color][/b] obj [b][color=DARKRED]'[/color][/b]InsertionPoint[b][color=RED])[/color][/b]
               [b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
           ObjectList
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vla-delete[/color][/b] ss[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] block [b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] attribute [b][color=RED])[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] tag [b][color=RED]([/color][/b][b][color=BLUE]vla-get-TagString[/color][/b] attribute[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                   [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vla-put-TextString[/color][color=RED])[/color][/b]
                     [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] attribute [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *start [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] *start[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                   [b][color=RED])[/color][/b]
                 [b][color=RED])[/color][/b]
               [b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b] block [b][color=DARKRED]'[/color][/b]GetAttributes[b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] car[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] ObjectList
           [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] point1 point2 [b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caddr[/color][/b] point1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caddr[/color][/b] point2[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] UFlag
       [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] doc[b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

Posted

Hello,

 

Thanks for your help.

 

I have a couple of small ammendments I'd like to introduce to refine the procedure.

 

I think it might be easier if I manually chose the order in which the blocks/trees are numbered as the random pattern of the trees doesn't seem lend itself particularly well to automatic number generating system.

 

So, if I could select a particular block, then a number be assigned to it and saved as an attribute ID, which is displayed on screen; this will allow me to tell which trees I've already selected.

 

This is a little more time labour intensive but allows me to chose the order in which the blocks/trees are numbered.

 

Once again many thanks for your help it is much appreciated.

 

Alistair

Posted
(defun c:AttNum (/ tag dxf ent eLst)

 (setq dxf (lambda (c l) (cdr (assoc c l))))

 (setq tag "TAG1") ;; Tag to be Updated

 (setq *start (cond (*start) ( 1 ))
       *start (1- (cond (  (getint (strcat "\nSpecify Starting Number <"
                                     (itoa *start) "> : ")))
                        (*start))))
 (while
   (progn
     (setq ent (car (entsel (strcat "\nSelect Block Number "
                              (itoa (setq *start (1+ *start))) " <Exit> : "))))

     (cond (  (eq 'ENAME (type ent))

              (if (and (eq "INSERT" (dxf 0 (entget ent)))
                       (= 1 (dxf 66 (entget ent))))

                (while (not (eq "SEQEND" (dxf 0 (setq eLst (entget (setq ent (entnext ent)))))))
                  (if (eq tag (dxf 2 elst))
                    (entupd
                      (dxf -1
                        (entmod
                          (subst
                            (cons 1 (itoa *start)) (assoc 1 eLst) eLst)))) t))

                (princ "\n** Must be an Attributed Block **"))))))
 (princ))

Posted

Hello Lee,

 

Thanks very much for your help; however, the number isn't being displayed.

 

Could this be something I've not setup in the block attributes?

 

Many thanks

 

Alistair

Posted

Many thanks for your help Lee, it's working now.

 

I may require help in the future as I progress and try to automate more of the drawing process.

 

Many thanks,

 

Alistair

  • 8 months later...
Posted

As requested via PM:

 

(defun c:AttNum ( / *error* _StartUndo _EndUndo doc ss lst ) (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (setq doc  (vla-get-ActiveDocument (vlax-get-acad-object)))  

 (setq *tag (cond ( *tag ) ( "TAG1" ))
       
 )

 (setq *tag
   (strcase
     (cond
       (
         (eq ""
           (setq tmp
             (getstring
               (strcat "\nSpecify Attribute Tag to be Numbered <"
                 (setq *tag
                   (cond ( *tag ) ( "TAG1" ))
                 )
                 "> : "
               )
             )
           )
         )
         *tag
       )
       ( tmp )
     )
   )
 )

 (setq *num
   (1-
     (cond
       (
         (getint
           (strcat "\nSpecify Starting Number <"
             (itoa
               (setq *num
                 (1+
                   (cond ( *num ) ( 0 ))
                 )
               )
             )
             "> : "
           )
         )
       )
       ( *num )
     )
   )
 )

 (if (ssget "_:L" '((0 . "INSERT") (66 . 1)))
   (progn      
     (vlax-for o (setq ss (vla-get-ActiveSelectionSet doc))
       (setq lst
         (cons
           (cons (vlax-get o 'InsertionPoint) o) lst
         )
       )
     )
     (vla-delete ss)

     (_StartUndo doc)

     (mapcar
       (function
         (lambda ( block )
           (mapcar
             (function
               (lambda ( attrib )
                 (if (eq *tag (strcase (vla-get-TagString attrib)))
                   (vla-put-TextString attrib (setq *num (1+ *num)))
                 )
               )
             )
             (vlax-invoke (cdr block) 'GetAttributes)
           )
         )
       )
       (vl-sort lst
         (function
           (lambda ( a b ) (> (cadar a) (cadar b)))
         )
       )
     )

     (_EndUndo doc)
   )
 )

 (princ)
)

 

Posted for all to benefit.

Posted

ohhh wow thank you very much Lee Mac, you even make it so that it will ask for the tag label instead of stuck in the lisp .. i like i like :)

thank you again for your time.

James

  • 4 months later...
Posted

I have been away from ACAD for several years. I remember a similar lisp or VBA that would allow me to select the blocks and then renumber in a specified increment. I like this code, however, I have a few questions

 

1) is there a way to remove the "tag" specific code line so I can use on different blocks

2) is there a way to select the order or select all the same block and have the attribute update with the order it was inserted

 

 

I downloaded this lisp, it works okay, but changes the font type in my block; http://www.cadstudio.cz/en/download.asp?file=InsertC

 

lastly, I remember a way that the block would automatically increase the number as i inserted the block.

 

sorry for the odd questions, its been over 2 years.

 

(defun c:AttNum (/ tag dxf ent eLst)

 (setq dxf (lambda (c l) (cdr (assoc c l))))

 (setq tag "TAG1") ;; Tag to be Updated

 (setq *start (cond (*start) ( 1 ))
       *start (1- (cond (  (getint (strcat "\nSpecify Starting Number <"
                                     (itoa *start) "> : ")))
                        (*start))))
 (while
   (progn
     (setq ent (car (entsel (strcat "\nSelect Block Number "
                              (itoa (setq *start (1+ *start))) " <Exit> : "))))

     (cond (  (eq 'ENAME (type ent))

              (if (and (eq "INSERT" (dxf 0 (entget ent)))
                       (= 1 (dxf 66 (entget ent))))

                (while (not (eq "SEQEND" (dxf 0 (setq eLst (entget (setq ent (entnext ent)))))))
                  (if (eq tag (dxf 2 elst))
                    (entupd
                      (dxf -1
                        (entmod
                          (subst
                            (cons 1 (itoa *start)) (assoc 1 eLst) eLst)))) t))

                (princ "\n** Must be an Attributed Block **"))))))
 (princ))

  • 5 years later...
Posted (edited)

Thank LeeMac

I crudely modified to allow for:

  • increment selection
  • prefix & suffix

(defun c:AttNum	(/	     *error*	 MakeVariant Itemp
	 MakeSelectionSet	 DOC	     OBJ
	 OBJECTLIST  SS		 TAG	     UFLAG
	)
 (vl-load-com)
 ;; Lee Mac  ~  15.04.10

 (setq tag "SM_TAG")

 (defun *error* (msg)
   (if	uFlag
     (vla-EndUndoMark
(vla-get-ActiveDocument
  (vlax-get-acad-object)
)
     )
   )
   (or	(wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )

 (defun MakeVariant (data datatype)
   (vlax-make-variant
     (vlax-safearray-fill
(vlax-make-safearray
  (eval datatype)
  (cons 1 (length data))
)
data
     )
   )
 )

 (defun Itemp (collection item / result)
   (if	(not (vl-catch-all-error-p
       (setq result
	      (vl-catch-all-apply
		(function vla-item)
		(list collection item)
	      )
       )
     )
)
     result
   )
 )

 (defun MakeSelectionSet (ref / SelSets SelSet)
   (if	(setq SelSet
       (itemp
	 (setq SelSets
		(vla-get-SelectionSets
		  (vla-get-ActiveDocument
		    (vlax-get-acad-object)
		  )
		)
	 )
	 ref
       )
)

     (vla-delete SelSet)
   )
   (vla-add SelSets ref)
 )

 (setq	*start
 (cond
   (*start)
   (1)
 )
 )


;;;  (setq *start
;;;    (1-
;;;      (cond
;;;        (  (getint
;;;             (strcat "\nSpecify Starting Number <"
;;;               (itoa *start) "> : "
;;;             )
;;;           )
;;;        )
;;;        (*start)
;;;      )
;;;    )
;;;  )

 (setq	startnum
 (cond
   (startnum)
   (1)
 )
 )
 
 (setq	startnum
 (cond
   ((getint
      (strcat "\nSpecify Starting Number <"
	      (itoa startnum)
	      "> : "
      )
    )
   )
   (startnum)
 )
 )
 
 (setq	INC
 (getint
   (strcat "\nSpecify Increment "
   )
 )
 )
 
 (setq *start (- startnum INC))	; lm var set
 
 (setq	prefix
 (getstring
   (strcat "\nSpecify Prefix"
   )
 )
 )
 (setq	sufix
 (getstring
   (strcat "\nSpecify Sufix"
   )
 )
 )
				;							rc


 (if (zerop
(vla-get-Count
  (setq	ss
	 (vla-get-PickFirstSelectionSet
	   (setq doc
		  (vla-get-ActiveDocument
		    (vlax-get-acad-object)
		  )
	   )
	 )
  )
)
     )
   (progn
     (setq ss (MakeSelectionSet "Tree_SS"))
     (vla-SelectOnScreen
ss
(MakeVariant '(0 66) vlax-vbInteger)
(MakeVariant '("INSERT" 1) vlax-vbVariant)
     )
   )
 )
 (if (not
(zerop
  (vla-get-Count ss)
)
     )
   (progn
     (setq UFlag
     (not
       (vla-StartUndoMark doc)
     )
     )
     (vlax-for	obj ss
(setq ObjectList
       (cons
	 (cons obj
	       (vlax-safearray->list
		 (vlax-variant-value
		   (vlax-get-property obj 'InsertionPoint)
		 )
	       )
	 )
	 ObjectList
       )
)
     )
     (vla-delete ss)
     (mapcar
(function
  (lambda (block)
    (mapcar
      (function
	(lambda	(attribute)
	  (if (eq tag (vla-get-TagString attribute))
	    (vl-catch-all-apply
	      (function vla-put-TextString)
	      (list attribute
		    (strcat prefix
			    (itoa (setq *start (+ INC *start)))
			    sufix
		    )
	      )			;rc
	    )
	  )
	)
      )
      (vlax-invoke block 'GetAttributes)
    )
  )
)
(mapcar	(function car)
	(vl-sort ObjectList
		 (function
		   (lambda (point1 point2)
		     (< (caddr point1) (caddr point2))
		   )
		 )
	)
)
     )
     (setq UFlag
     (vla-EndUndoMark doc)
     )
   )
 )
 (princ)
)

Edited by SunnyTurtle

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