AMOVE from ASMI: selectable attributes?

June 26, 2009

First of all Thanks ASMI for the AMOVE lisp. It works great. Now is it possible to modify it so that I can pick certain attributes to move inside the block and not all the attributes.

ie: I have a block with many attributes, I want to pick some attributes to align to left and some attributes to align to the right of the block(s) depending on space avalible on the drawing itself.

Here's the code written by ASMI. Great code ASMI!

;; ==================================================================== ;;
;;                                                                      ;;
;;  AMOVE.LSP - Moves multiple attributes simultaneously                ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  Command(s) to call: AMOVE                                           ;;
;;                                                                      ;;
;;  Select multuple blocks and move all attributes simultaneously.      ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY    ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR        ;;
;;  PARTS OF IT ABSOLUTELY FREE.                                        ;;
;;                                                                      ;;
;;  THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY      ;;
;;  DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS        ;;
;;  FOR A PARTICULAR USE.                                               ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.0, 14th Julay 2007, Riga, Latvia                                 ;;
;;  © Aleksandr Smirnov (ASMI)                                          ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)           ;;
;;                                                                      ;;
;;                             http://www.asmitools.com                 ;;
;;                                                                      ;;
;; ==================================================================== ;;

(defun c:amove(/ atSet actDoc atLst actSp curTxt
         aFlg laySt mDel bPt dPt *error*)

 (vl-load-com)

 (defun *error*(msg)
   (if tSet
     (progn
         (setvar "CMDECHO" 0)
         (command "_.erase" tSet "")
         (setvar "CMDECHO" 1)
       ); end progn
     ); end if
   (if laySt
      (asmi-LayersStateRestore laySt)
     ); end if
   (if actDoc
      (vla-EndUndoMark actDoc)
      ); end if
    (princ)
   ); end of *error*

 
 (defun asmi-LayersUnlock(/ restLst)
  (setq restLst '())
    (vlax-for lay(vla-get-Layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
         (setq restLst
           (append restLst
             (list
               (list
                lay
                 (vla-get-Lock lay)
                ); end list
              ); end list
            ); end append
          ); end setq
       (vla-put-Lock lay :vlax-false)
     ); end vlax-for
  restLst
 ); end of asmi-LayersUnlock

 
 (defun asmi-LayersStateRestore(StateList)
   (foreach lay StateList
     (vla-put-Lock(car lay)(cadr lay))
    ); end foreach
   (princ)
 ); end of asmi-LayersStateRestore

 
 (defun asmi-GetAttributes(Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr(vl-catch-all-apply 'vlax-safearray->list
            (list(vlax-variant-value
                    (vla-GetAttributes Block)))))))
          atArr); end if
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr(vl-catch-all-apply 'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr); end if
     ); end append
   ); end asmi-GetAttributes

 
 (defun asmi-GetActiveSpace(/ actDoc)
   (setq actDoc
          (vla-get-ActiveDocument
             (vlax-get-acad-object)))
       (if(= 1(getvar "TILEMODE"))
          (vla-get-ModelSpace actDoc)
           (vla-get-PaperSpace actDoc)
        ); end if
     ); end of asmi-GetActiveSpace

 (princ "\n<<< Select blocks to move Attributes >>> ")
 (if
   (setq atLst(ssget '((0 . "INSERT")(66 . 1))))
   (progn
     (setq atLst(apply 'append
                  (mapcar 'asmi-GetAttributes
                    (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex atLst)))))
                    ); end apply
           tSet(ssadd)
           actSp(asmi-GetActiveSpace)
           laySt(asmi-LayersUnlock)
    actDoc(vla-get-ActiveDocument
	    (vlax-get-acad-object))
            ); end setq
  (vla-StartUndoMark actDoc)
  (foreach att atLst
      (setq curTxt
         (vla-AddText actSp "Text"
           (vlax-3D-point '(0.0 0.0 0.0))1.0))
             (ssadd(vlax-vla-object->ename curTxt)tSet)
               (foreach pr '("TextString" "StyleName" "Height"
	              "ScaleFactor" "Backward" "ObliqueAngle"
	              "UpsideDown" "Rotation" "Color" "Layer"
	              "Linetype" "Lineweight" "Alignment")
                  (vlax-put-Property curTxt pr
                      (vlax-get-Property att pr))
                ); end foreach
    (cond
      ((= 0(vla-get-Alignment att))
         (vla-put-InsertionPoint curTxt
           (vla-get-InsertionPoint att))
             (setq aFlg "InsertionPoint")
        ); end condition #1
      ((member(vla-get-Alignment att) '(3 5))
         (vla-put-InsertionPoint curTxt
           (vla-get-InsertionPoint att))
         (vla-put-TextAlignmentPoint curTxt
           (vla-get-TextAlignmentPoint att))
         (vla-put-ScaleFactor curTxt
           (vla-get-ScaleFactor att))
           (setq aFlg "InsertionPoint")
         ); end condition #2
      ((not(member(vla-get-Alignment att)'(0 3 5)))
          (vla-put-TextAlignmentPoint curTxt
            (vla-get-TextAlignmentPoint att))
            (setq aFlg "TextAlignmentPoint")
         ); end condition #3
       ); end cond
    ); end foreach
     (command "_.move" tSet "" pause pause)
     (setq mDel
        (mapcar '-
          (vlax-get
            (vlax-ename->vla-object
              (ssname tSet(1-(sslength tSet))))aFlg)
                (vlax-get(last atLst) aFlg)
         ); end mapcar
       ); end setq
     (foreach att atLst
        (setq bPt(vlax-get att aFlg)
              dPt(mapcar '+ bPt mDel)
              ); end setq
        (vla-Move att(vlax-3d-Point bPt)(vlax-3d-Point dPt))
       ); end foreach
        (setvar "CMDECHO" 0)
        (command "_.erase" tSet "")
        (setvar "CMDECHO" 1)
        (asmi-LayersStateRestore laySt)
        (vla-EndUndoMark actDoc)
      ); end progn
    ); end if
 (princ)
 ); end of c:amove

(princ "\n[info] http:\\\\www.AsmiTools.com [info]")
(princ "\n[info] Type AMOVE to move multiple attributes at once. [info]")

June 27, 2009

This will work on individual Blocks, let me know if you had something else in mind

(defun c:amove2 (/ *error* lklst ent Obj bPt gr)
 (vl-load-com)

 (defun *error* (msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (if lklst
     (foreach l lklst
       (vla-put-lock
         (car l) (cdr l))))
   (if (not
         (wcmatch
           (strcase msg)
             "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat "\n<< Error: " msg " >>")))
   (redraw)
   (princ))
           

 (vlax-for l
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (setq lklst
     (cons
       (cons l
         (vla-get-lock l)) lklst))
   (vla-put-lock l :vlax-false))

 (while
   (progn
     (setq ent
       (car (nentsel "\nSelect Attribute: ")))
     (cond
       ((eq 'ENAME (type ent))
        (if
          (not
            (eq "ATTRIB"
                (cdr (assoc 0 (entget ent)))))
          (princ "\n** Object is not an Attribute **")
          nil))
       (t (princ "\n** Nothing Selected **")))))

 (setq Obj (vlax-ename->vla-object ent)
       bPt (vlax-safearray->list
             (vlax-variant-value
               (vla-get-InsertionPoint Obj))))
 
 (vla-StartUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (while
       (and
         (setq gr
           (grread t 13 0))
         (eq 5 (car gr)))
   (redraw)
   (vla-move Obj
     (vla-get-InsertionPoint Obj)
       (vlax-3D-point (cadr gr)))
   (grdraw bPt (cadr gr) 3 1))

 (vla-EndUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (foreach l lklst
   (vla-put-lock
     (car l) (cdr l)))

 (redraw)
 (princ))

June 27, 2009

Thx LeeMac, I'll have to try your code once I get back to work. I'm on holiday for a week.

June 28, 2009

Another option:

This will move multiple attributes by tag:


;; ============ Amove2.lsp ===============
;;
;;  FUNCTION:
;;  Will move Multiple Attribute Tags
;;
;;  SYNTAX: AMOVE2
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  VERSION:
;;  1.0  ~  28.06.2009
;;
;; ====================================

(defun c:amove2 (/ *error* lklst ent Blk
                  Obj bNme ss bPt ObjLst)
 (vl-load-com)

 (defun *error* (msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (if lklst
     (foreach l lklst
       (vla-put-lock
         (car l) (cdr l))))
   (if (not
         (wcmatch
           (strcase msg)
             "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat "\n<< Error: " msg " >>")))
   (redraw)
   (princ))
           

 (vlax-for l
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (setq lklst
     (cons
       (cons l
         (vla-get-lock l)) lklst))
   (vla-put-lock l :vlax-false))

 (while
   (progn
     (setq ent
       (car (nentsel "\nSelect Attribute: ")))
     (cond
       ((eq 'ENAME (type ent))
        (if
          (not
            (eq "ATTRIB"
                (cdr (assoc 0 (entget ent)))))
          (princ "\n** Object is not an Attribute **")
          nil))
       (t (princ "\n** Nothing Selected **")))))

 (setq Blk
   (vla-ObjectIdtoObject
     (vla-get-ActiveDocument
       (vlax-get-acad-object))
     (vla-get-OwnerId
       (setq Obj
         (vlax-ename->vla-object ent)))))

 (setq bNme
   (if (vlax-property-available-p Blk 'EffectiveName)
     (vla-get-EffectiveName Blk)
       (vla-get-Name Blk)))

 (setq ss
   (ssget "_X" (list (cons 0 "INSERT")
                       (cons 2 bNme)
                         (cons 66 1))))

 (if (setq bPt (getpoint "\nSelect Base Point: "))
   (progn
     (vla-StartUndoMark
       (vla-get-ActiveDocument
         (vlax-get-acad-object)))
     (setq ObjLst
       (vl-remove-if-not
         (function
           (lambda (x)
             (eq (vla-get-TagString x)
                 (vla-get-TagString Obj))))
         (apply 'append
           (mapcar 'asmi-GetAttributes
             (mapcar 'vlax-ename->vla-object
               (mapcar 'cadr (ssnamex ss)))))))

     (lmac-ss-drag-move
       "\nMove Attributes" ObjLst bPt t)

     (vla-EndUndoMark
       (vla-get-ActiveDocument
         (vlax-get-acad-object)))))
 
 (foreach l lklst
   (vla-put-lock
     (car l) (cdr l)))

 (princ))

 ;;Asmi
(defun asmi-GetAttributes (Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetAttributes Block)))))))
          atArr)
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr)))  

;; Ghosting Example, by Lee McDonnell

(defun lmac-ss-drag-move (msg ss pt hi  / oBjLst MiP MaP
                                         bsvec cPLst gr)
 (vl-load-com)
 (if msg
   (prompt
     (strcat
       (if (not (vl-string-search "\n" msg))
         "\n""") msg)))
 (or (and (listp ss) (setq OBjLst ss))
     (setq oBjLst
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr
             (ssnamex ss))))))
 (vla-getBoundingBox
   (car oBjLst) 'MiP 'MaP)
     (setq bsvec
       (mapcar '-
         (vlax-safearray->list MiP) pt))
;;;  (mapcar
;;;    (function
;;;      (lambda (x)
;;;        (vla-highlight x :vlax-true)))
;;;          (setq cpLst
;;;            (mapcar 'vla-copy oBjLst)))
 (while
       (eq 5
         (car
           (setq gr (grread 't )))
             (redraw)
     (if
       (and
         (eq 5 (car gr))
           (listp (cadr gr)))
       (progn
         (vla-getBoundingBox
           (car oBjLst) 'MiP 'MaP)
             (mapcar
               (function
                 (lambda (x)
                   (vla-move x
                     (vlax-3D-point
                       (mapcar '-
                         (vlax-safearray->list MiP) bsVec))
                           (vlax-3D-point
                             (cadr gr)))))
                               oBjLst)
         (if hi
           (grdraw pt (cadr gr) 3 1)))))
;;;  (mapcar
;;;    (function
;;;      (lambda (x)
;;;        (vl-catch-all-apply
;;;          'vla-delete
;;;            (list x)))) cpLst)
 (redraw))

I have also updated the code in my first post to add some features.

June 29, 2009

Thank you very much for amove2

June 30, 2009

Thank you very much for amove2

Your welcome, I'm glad you like it

June 30, 2009

Lee,

I just tried the code above. Very good job, I had to say that !!

Imagine, I was just curious if you'd done some lisping lately... and yup, you did.

Nice one, I'll keep that one in mind for I might have a use for it sometime.

Regards,

Marco

June 30, 2009

Your welcome, I'm glad you like it

Again and again, Lee Mac to the rescue!

Great lisp work, as always!

July 1, 2009

Lee,

I just tried the code above. Very good job, I had to say that !!

Imagine, I was just curious if you'd done some lisping lately... and yup, you did.

Nice one, I'll keep that one in mind for I might have a use for it sometime.

Regards,

Marco

Again and again, Lee Mac to the rescue!

Great lisp work, as always!

Thanks guys

July 1, 2009

I added the following code at the beginning and end:

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

;save current UCS

(setq mUCS (getvar "UCSNAME"))

(command "_UCS" "")

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

;...(the code).........

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

;restore UCS

(command "UCS" "r" mUCS )

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

Regards, ArqStaad

July 1, 2009

I added the following code at the beginning and end:

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

;save current UCS

(setq mUCS (getvar "UCSNAME"))

(command "_UCS" "")

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

;...(the code).........

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

;restore UCS

(command "UCS" "r" mUCS )

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

Regards, ArqStaad

Ok, I didn't make the code UCS compatible, but you could also achieve this using the TRANS function.

Lee

July 6, 2009

LeeMac,

Thanks for taking the time to helping me out. The latest version of this amove2 doesn't seem to work for dynamic blocks. Your first try seems to work fine. ASMI's code can do multiple selected blocks, but yours can do selected attributes. I really need something of both worlds. Be able to select multiple blocks and then select certain multiple attributes to move.

ie: BLOCKA has ATT1,ATT2,ATT3,ATT4. My drawing has 10 copies of BLOCKA, I want to select 5 of the BLOCKA and move their ATT1 and ATT2 to the left.

Your first code works fine, except I need it to be able to select more than one blocks to modify and then select more than one attributes within the block to move. On top of all that, we use dynamic blocks exclusively at work here. Sorry if this is too much to ask. If it's too complicated, then don't worry about it.

I've tried your Attribute Suite, but none of the commands works on dynamic blocks.

July 6, 2009

LeeMac,
Thanks for taking the time to helping me out. The latest version of this amove2 doesn't seem to work for dynamic blocks. Your first try seems to work fine. ASMI's code can do multiple selected blocks, but yours can do selected attributes. I really need something of both worlds. Be able to select multiple blocks and then select certain multiple attributes to move.

ie: BLOCKA has ATT1,ATT2,ATT3,ATT4. My drawing has 10 copies of BLOCKA, I want to select 5 of the BLOCKA and move their ATT1 and ATT2 to the left.

Your first code works fine, except I need it to be able to select more than one blocks to modify and then select more than one attributes within the block to move. On top of all that, we use dynamic blocks exclusively at work here. Sorry if this is too much to ask. If it's too complicated, then don't worry about it.

I would recommend you try....

I've tried your Attribute Suite, but none of the commands works on dynamic blocks.

ah... I see you have

I will see what I can do - having mostly worked on '04, my experience with Dynamic blocks is extremely limited...

July 10, 2009

Just so if someone else is looking for the same thing as me. I've found another version of attribute move from the theswam.org. This one seems to do what I'm asking for. Move selected multiple attributes on multiple dynamic blocks. I still like the attribute suite from LeeMac better, but too bad it doesn't work on dynamic blocks. Oh well, you can't always get what you want.

Command is "MoveAttText".

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


(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)
)

Sign In

AMOVE from ASMI: selectable attributes?

Recommended Posts

JeepMaster

Lee Mac

JeepMaster

Lee Mac

arqstaad

Lee Mac

MarcoW

Tankman

Lee Mac

arqstaad

Lee Mac

JeepMaster

Lee Mac

JeepMaster

Join the conversation

Tutorials

Forums

Activity