Here is mine, with some changes made the the sub posted in the other thread. I think I got all the subs.
(defun c:MoveAttText (/ ActDoc Plss CurSpace ObjList tempPtList PtList tempPline BasePt NewPt *error*)
(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 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)
)
)
(if (> (sslength Plss) 0)
(progn
(setvar 'cmdecho 1)
(command "_.move"
Plss
""
(setq BasePt (getpoint))
pause
)
(setq NewPt (getvar 'lastpoint))
(setvar 'cmdecho 0)
(command "_.erase" Plss "")
(foreach obj ObjList
(vlax-invoke obj 'Move BasePt NewPt)
)
)
)
(vla-EndUndoMark ActDoc)
(princ)
)
(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
)