Move all attributes of selected blocks relative to block(s) symbol.

[b_worland]

Hi All,

There are several posts discussing moving attributes relative to their respective block symbol by selecting the attributes.  I have a very good lisp to do that  - kudos to T.Willey, VovKa and Gile from The Swamp. I have posted that lisp below. 

But would anyone have a lisp to move attributes by selecting multiple blocks?

Problem - I have a drawing that has multiple blocks with the same and different block names. Each block has multiple attributes of the same and different attribute names.  All the attributes for every block are too far away from their respective block symbol. I want to move the attributes closer to the block symbol. But i don't want to do this by selecting attributes or one block at a time . I just want to select some blocks or every block in one go then move their attributes closer to their symbols by the same relative distance. The drawing is attached.

Would anyone have or be able to create a lisp that could allow for - 

1. User runs lisp. Lisp prompts for selection of some or all blocks (including ability to use previous selection set or select similar)

2. Lisp then selects all attributes of every block

3. Lisp requests user to select a base point and then second point.

4. Lisp moves all selected attributes by the same relative distance the user specified in step 3

I wish i had some programming knowledge but I don't. Any help appreciated.

Lisp to move attributes by selecting the attributes

; Lisp to move attributes
;
; Thanks to T.Willey & VovKa - Dec 2007
; http://www.theswamp.org/index.php?topic=19881.15

(defun SelAtts (Message bAllowText / Sel EntData Pt1 Pt3 gr p1 p2 p3 p4 po ss SelMode SelObjList flag)
; updated by gile @theSwamp.org to show the selection correctly.
; updated by T.Willey to allow the option to select text objects, not mtext
; updated by T.Willey, added new sub to see if the selection box and the bounding box of the objects
; selected cross, so that a true crossing is simulated

(defun DoBoxesCross (PtList1 PtList2 / Intersect cnt cnt2)

(setq cnt 0)
(while
(and
(not Intersect)
(< cnt 4)
)
(setq cnt2 0)
(repeat 4
(if
(inters
(nth cnt PtList1)
(nth
(if (equal cnt 3)
0
(1+ cnt)
)
PtList1
)
(nth cnt2 PtList2)
(nth
(if (equal cnt2 3)
0
(1+ cnt2)
)
PtList2
)
T
)
(setq Intersect T)
)
(setq cnt2 (1+ cnt2))
)
(setq cnt (1+ cnt))
)
Intersect
)
;----------------------------------------------------------------------------------------------------
(defun GetAttSelection (ss SelMode / ObjList PtList TestList ll ur tempPtList SelObjList)

(foreach lst (ssnamex ss)
(cond
((equal (car lst) 3)
(setq ObjList (cons (vlax-ename->vla-object (cadr lst)) ObjList))
)
((equal (car lst) -1)
(foreach sub-lst (cdr lst)
(setq PtList (cons (cadr sub-lst) PtList))
)
)
)
)
(foreach obj ObjList
(cond
((= (vla-get-ObjectName obj) "AcDbBlockReference")
(foreach att (vlax-invoke obj 'GetAttributes)
(if
(and
(/= (vla-get-TextString att) "")
(= (vla-get-Invisible att) :vlax-false)
)
(progn
(setq TestList nil)
(vla-GetBoundingBox att 'll 'ur)
(setq tempPtList
(list
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list (car ur) (cadr ll) (caddr ll))
(list (car ll) (cadr ur) (caddr ll))
)
)
(foreach pt tempPtList
(if
(and
(< (caar PtList) (car pt) (caadr PtList))
(< (cadar PtList) (cadr pt) (cadr (caddr PtList)))
)
(setq TestList (cons T TestList))
)
)
(if (= SelMode "Windowing")
(if (equal (length TestList) 4)
(setq SelObjList (cons att SelObjList))
)
(if
(or
TestList
(DoBoxesCross PtList tempPtList)
)
(setq SelObjList (cons att SelObjList))
)
)
)
)
)
)
(
(or
(= (vla-get-ObjectName obj) "AcDbText")
(= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
)
(if
(or
(/= (vla-get-TextString obj) "")
(and
(vlax-property-available-p obj 'TagString)
(/= (vla-get-TagString obj) "")
)
)
(progn
(setq TestList nil)
(vla-GetBoundingBox obj 'll 'ur)
(setq tempPtList
(list
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list (car ur) (cadr ll) (caddr ll))
(list (car ll) (cadr ur) (caddr ll))
)
)
(foreach pt tempPtList
(if
(and
(< (caar PtList) (car pt) (caadr PtList))
(< (cadar PtList) (cadr pt) (cadr (caddr PtList)))
)
(setq TestList (cons T TestList))
)
)
(if (= SelMode "Windowing")
(if (equal (length TestList) 4)
(setq SelObjList (cons obj SelObjList))
)
(if
(or
TestList
(DoBoxesCross PtList tempPtList)
)
(setq SelObjList (cons obj SelObjList))
)
)
)
)
)
)
)
SelObjList
)
;----------------------------------------------------------------------------------------------------
(defun gr-sel (/ loop gr pt)

(setq loop T)
(while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)
(cond
((= (car gr) 5)
(setq pt (cadr gr))
)
(
(or
(member gr '((2 13) (2 32)))
(or (= (car gr) 11) (= (car gr) 25))
)
(setq loop nil
pt nil
)
)
)
)
(if pt
(cond
((car (nentselp pt)))
(pt)
)
)
)
;---------------------------------------------------------------------------------------------------------
(setvar "ErrNo" 0)
(while
(and
(princ (strcat "\n" Message))
(setq sel (gr-sel))
)
(if (listp sel)
(progn
(setq p1 (list (car sel) (cadr sel))
pt1 (trans p1 1 2)
)
(princ "\nSpecify the opposite corner: ")
(while (and (setq gr (grread T 12 1)) (/= (car gr) 3))
(if (= 5 (car gr))
(progn
(redraw)
(setq pt3 (trans (cadr gr) 1 2)
p2 (trans (list (car pt3) (cadr pt1)) 2 1)
p3 (list (caadr gr) (cadadr gr))
p4 (trans (list (car pt1) (cadr pt3)) 2 1)
)
(if (< (car pt1) (car (trans p2 1 2)))
(progn
(setq SelMode "Windowing")
(grvecs (list 255 p1 p2 255 p2 p3 255 p3 p4 255 p4 p1))
)
(progn
(setq SelMode "Crossing")
(grvecs
(list -255 p1 p2 -255 p2 p3 -255 p3 p4 -255 p4 p1)
)
)
)
)
)
)
(redraw)
(if
(if bAllowText
(setq ss (ssget "_C" p1 p3 '((0 . "INSERT,TEXT,ATTDEF"))))
(setq ss (ssget "_C" p1 p3 '((0 . "INSERT"))))
)
(setq SelObjList (append SelObjList (GetAttSelection ss SelMode)))
)
)
(progn
(setq EntData (entget Sel))
(if
(or
(= (cdr (assoc 0 EntData)) "ATTRIB")
(and
bAllowText
(vl-position (cdr (assoc 0 EntData)) '("TEXT" "ATTDEF"))
)
)
(progn
(setq SelObjList
(cons (vlax-ename->vla-object Sel) SelObjList)
)
(redraw Sel 3)
)
)
)
)
(foreach att SelObjList
(redraw (vlax-vla-object->ename att) 3)
)
)
(foreach att SelObjList
(redraw (vlax-vla-object->ename att) 4)
)
SelObjList
)

;----------------------------------------------------------------------------------------------------
(defun GetBBPoints (VlaxObj / tmpLL tmpUR LowLeft LowRight UpRight LowRight)
; Get bounding box points for a valid vlax-object
; Returns a list of point lists.

(vla-GetBoundingBox VlaxObj 'tmpLL 'tmpUR)
(setq LowLeft (safearray-value tmpLL))
(setq UpRight (safearray-value tmpUR))
(setq LowRight (list (car UpRight) (cadr LowLeft) (caddr UpRight)))
(setq UpLeft (list (car LowLeft) (cadr UpRight) (caddr LowLeft)))
(list LowLeft LowRight UpRight UpLeft)
)

;---------------------------------------------------------------------------------------------------------

(defun c:MoveAttText (/ ActDoc Plss CurSpace ObjList tempPtList PtList tempPline BasePt NewPt *error* LL UR)

(defun *error* (msg)

(command)
(if (> (sslength Plss) 0)
(command "_.erase" Plss "")
)
(vla-EndUndoMark ActDoc)
)

(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the "block object" for the active space
; Thanks to Jeff Mishler

(if (= (getvar "cvport") 1)
(vla-get-PaperSpace Doc)
(vla-get-ModelSpace Doc)
)
)

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq Plss (ssadd))
(setq CurSpace (GetCurrentSpace ActDoc))
(if (setq ObjList (SelAtts "Select attributes and/or text to move: " T))
(foreach obj ObjList
(setq tempPtList (GetBBPoints obj))
(setq BasePt (car tempPtList))
(setq PtList nil)
(foreach pt tempPtList
(setq PtList (cons (car pt) PtList))
(setq PtList (cons (cadr pt) PtList))
)
(setq tempPline
(vlax-invoke
CurSpace
'AddLightWeightPolyline
(reverse PtList)
)
)
(vla-put-Closed tempPline :vlax-true)
(ssadd (vlax-vla-object->ename tempPline) Plss)
)
)

(setq
BasePt (apply
(function
(lambda (p1 p2)
(mapcar (function (lambda (e1 e2) (/ (+ e1 e2) 2.))) p1 p2)
)
)
((lambda (Coords)
(apply
(function
(lambda (mn mx) (mapcar (function (lambda (n x) (list n x))) mn mx))
)
(mapcar (function (lambda (c) (list (apply 'min c) (apply 'max c))))
(list (mapcar 'car Coords) (mapcar 'cadr Coords))
)
)
)
(apply
'append
(mapcar
(function (lambda (Obj)
(vla-GetBoundingBox Obj 'LL 'UR)
(list (vlax-safearray->list LL) (vlax-safearray->list UR))
)
)
ObjList
)
)
)
)
)

(if (> (sslength Plss) 0)
(progn
(setvar 'cmdecho 1)
(command "_.move"
Plss
""
BasePt
pause
)
(setq NewPt (getvar 'lastpoint))
(setvar 'cmdecho 0)
(command "_.erase" Plss "")
(foreach obj ObjList
(vlax-invoke obj 'Move (append BasePt (cddr NewPt)) NewPt)
)
)
)
(vla-EndUndoMark ActDoc)
(princ)
)

[Moshe-A]

@b_worland  hi,

check this GATM command.

enjoy

Moshe

; global attrivutes move
(defun c:gatm (/ ss p0 p1 p2 p3 ename AcDbBlkRef AcDbAttrib )

 (if (and
       (not (prompt "\nSelect block reference(s)"))
       (setq ss (ssget '((0 . "insert") (66 . 1))))
       (setq p0 (getpoint "\nSpecify base point: "))
       (setq p1 (getpoint p0 "\nSpecify second point: "))
     )
  (progn
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq AcDbBlkRef (vlax-ename->vla-object ename))

    (foreach AcDbAttrib (vlax-invoke AcDbBlkRef 'GetAttributes)
     (cond
      ((member (vla-get-alignment AcDbAttrib) (list acAlignmentLeft acAlignmentAligned acAlignmentFit))
       (setq p2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionPoint AcDbAttrib))))
       (setq p3 (polar p2 (angle p0 p1) (distance p0 p1)))
       (vla-put-insertionPoint AcDbAttrib (vlax-3d-point p3))
      ); case
      ((member (vla-get-alignment AcDbAttrib) (list acAlignmentCenter acAlignmentMiddle acAlignmentRight))
       (setq p2 (vlax-safearray->list (vlax-variant-value (vla-get-TextAlignmentPoint AcDbAttrib))))
       (setq p3 (polar p2 (angle p0 p1) (distance p0 p1)))
       (vla-put-TextAlignmentPoint AcDbAttrib (vlax-3d-point p3))
      ); case
      ( t
       (prompt "\nattrib alignment is not covered.")
      )
     ); cond
      
     (vlax-release-object AcDbAttrib)
    ); foreach

    (vlax-release-object AcDbBlkRef)
   ); foreach
  ); progn
 ); if


 (princ)
); c:gatm

[b_worland · Accepted solution]

Hi Moshe,

Legend!!!!!. Thanks very much. Works perfectly.