Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Lisp to get attribute from selection for block name

22 REPLIES 22
SOLVED
Reply
Message 1 of 23
dvanerem
2043 Views, 22 Replies

Lisp to get attribute from selection for block name

I am trying to make a routine that would allow me to make a block out of a selection and name the block the attribute value from the selection. The selection will only have one attribute in it. It would also be nice if it could automatically select the very bottom left corner of the selection for the base point but I am not sure how to get to that point. I have tried to put something together but it does not appear to work, any help would be awesome. 

 

(defun c:QB (/ selectionset insertionpoint number Blockname)
(defun _getatt (block tag / att result)
(foreach att (vlax-invoke block 'getattributes)
(if (eq (strcase tag) (strcase (vla-get-tagstring att)))
(progn (setq result (vla-get-textstring att)))
)
)
result
)
(if (and (setq selectionset (ssget "_:L"))
(setq insertionpoint (getpoint "\n Specify insertion point :"))
)
(progn
(setq number 1
Blockname (_getatt)
)
(while (tblsearch "BLOCK" Blockname)
(setq Blockname
(strcat "MyBlock" (itoa (setq number (1+ number))))
)
)
(command "_.-Block" Blockname insertionpoint selectionset "")
(command "_.-insert" Blockname insertionpoint "" "" "")
)
(princ)
)
(princ)
)

Tags (2)
22 REPLIES 22
Message 21 of 23
Lee_Mac
in reply to: dvanerem

You're very welcome mid-awe Smiley Happy

 

dvanerem wrote:

Thank you Lee! This now works great for me! The draw order seems to retain itself how I show it which for me is great. 

 

Excellent, that's great to hear Smiley Happy

 

dvanerem wrote:

The only thing that would be nice to change would be if the block name already exists I would rather put a letter behind it, like F-100a instead of F-1001, the reason being I might have another part called F-1001 and the letter would just let me review for mistakes easier so i can see where we have a conflict. Other than that this is awesome! Thank you both so much for the help! 

 

Sure, try the following code:

 

(defun c:qb ( / blk bln bpt doc idx llp lst obj sel tmp )
    (if (setq sel (ssget "_:L" (list (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                      lst (cons obj lst)
                )
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
                    )
                    (setq bpt (cond ((mapcar 'min bpt (vlax-safearray->list llp))) ((vlax-safearray->list llp))))
                )
                (if (and (null bln)
                         (= "AcDbBlockReference" (vla-get-objectname obj))
                         (= :vlax-true (vla-get-hasattributes obj))
                         (snvalid (setq tmp (vla-get-textstring (car (vlax-invoke obj 'getattributes)))))
                    )
                    (setq bln tmp)
                )
            )
            (if bln
                (if (tblsearch "block" bln)
                    (progn
                        (setq tmp "")
                        (while (tblsearch "block" (strcat bln (setq tmp (LM:alpha++ tmp)))))
                        (setq bln (strcat bln tmp))
                    )
                )
                (setq bln "*U")
            )
            (setq doc (vla-get-activedocument (vlax-get-acad-object))
                  blk (vlax-invoke (vla-get-blocks doc) 'add bpt bln)
            )
            (vlax-invoke doc 'copyobjects (reverse lst) blk)
            (vlax-invoke
                (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                'insertblock bpt (vla-get-name blk) 1.0 1.0 1.0 0.0
            )
            (foreach obj lst (vla-delete obj))
            (princ (strcat "\nCreated block: \"" (vla-get-name blk) "\"."))
        )
    )
    (princ)
)

;; Alpha++  -  Lee Mac
;; Increments an uppercase alphabetical string by one, e.g. AZ => BA
;; a - [str] uppercase alphabetical string

(defun LM:alpha++ ( a )
    (   (lambda ( f ) (vl-list->string (reverse (f (reverse (vl-string->list a))))))
        (lambda ( l )
            (if l
                (if (= 90 (car l))
                    (cons 65 (f (cdr l)))
                    (cons (1+ (car l)) (cdr l))
                )
               '(65)
            )
        )
    )
)

(vl-load-com) (princ)

 

The LM:Alpha++ function is taken from my site here.

 

Lee

Message 22 of 23
dvanerem
in reply to: Lee_Mac

Works great!! Thank you!
Message 23 of 23
Lee_Mac
in reply to: dvanerem

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost