Topic: Lisp to move attributes

[Aerdvark]

I don't know but what about this one ?

http://www.cadtutor.net/forum/showthread.php?t=37859&highlight=leemac

[Pad]

Thanks Aerdvark but that lisps moves every attribute with the same tag.
What I am looking for is a modification of the lisp in this thread so that it automatically selects all the attributes on a selected block, instead of its current behaviour, where the attributes to be moved are selected individually.
Cheers

[Patrick_35]

Hi

A lisp from (gile)

Code: [Select]

;; MOVEATT (gile) 07/05/08
;; Déplace les attributs
;; Par défaut l'utilisateur sélectionne les attributs un par un
;; L'option "Bloc" permet de déplacer tous les attributs des blocs sélectionnés

(defun c:MoveAtt
       (/ space att lst1 lst2 ss1 ss2 tmp cl lay lck txt al p1 p2)
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (initget "Bloc")
  (setq att (nentsel "\nSélectionnez un attribut ou [Bloc] <Bloc>: "))
  (if (or (null att) (= att "Bloc"))
    (if (ssget '((0 . "INSERT") (66 . 1)))
      (vlax-for blk (setq ss1 (vla-get-ActiveSelectionSet *acdoc*))
(setq lst1 (append (vlax-invoke blk 'getAttributes) lst1))
      )
    )
    (progn
      (and
(setq att (car att))
(= (cdr (assoc 0 (entget att))) "ATTRIB")
(setq lst1 (cons (vlax-ename->vla-object att) lst1))
(redraw att 3)
      )
      (while (setq att (car (nentsel "\nSélectionnez un attribut: ")))
(and
  (= (cdr (assoc 0 (entget att))) "ATTRIB")
  (setq lst1 (cons (vlax-ename->vla-object att) lst1))
  (redraw att 3)
)
      )
    )
  )
  (if lst1
    (progn
      (vla-StartUndoMark *acdoc*)
      (setq space (if (= 1 (getvar "cvport"))
    (vla-get-PaperSpace *acdoc*)
    (vla-get-ModelSpace *acdoc*)
  )
    ss2   (ssadd)
    tmp   (vla-add (vla-get-Layers *acdoc*) "MoveAtt_tmp")
    cl   (vla-get-ActiveLayer *acdoc*)
      )
      (vla-put-ActiveLayer *acdoc* tmp)
      (foreach a lst1
(setq lay (vla-item (vla-get-Layers *acdoc*) (vla-get-Layer a)))
(and (= (vla-get-Lock lay) :vlax-true)
     (setq lck (cons lay lck))
     (vla-put-Lock lay :vlax-false)
)
(setq txt
       (vla-addText
space
(vla-get-TextString a)
(vla-get-InsertionPoint a)
(vla-get-Height a)
       )
)
(foreach prop '(Backward       Linetype       LinetypeScale
Normal        ObliqueAngle   Rotation
ScaleFactor    StyleName      Thickness
TrueColor      UpsideDown
       )
  (vlax-put-property txt prop (vlax-get-property a prop))
)
(setq al (vla-get-Alignment a))
(vla-put-Alignment txt al)
(and (member al '(0 3 5))
     (vla-put-InsertionPoint
       txt
       (vla-get-InsertionPoint a)
     )
)
(or (= 0 al)
    (vla-put-TextAlignmentPoint
      txt
      (vla-get-TextAlignmentPoint a)
    )
)
(setq ss2  (ssadd (vlax-vla-object->ename txt) ss2)
      lst2 (cons txt lst2)
)
      )
      (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      (function
(lambda ()
  (setq p1 (getpoint "\nSpécifiez le point de base: "))
  (vl-cmdf "_.move" ss2 "" p1 pause)
  (setq p2 (getvar "lastpoint"))
)
      )
    )
  )
)
(mapcar
   (function
     (lambda (a)
       (vla-move a
(vlax-3d-point (trans p1 1 0))
(vlax-3d-point (trans p2 1 0))
       )
     )
   )
   lst1
)
      )
      (vla-put-ActiveLayer *acdoc* cl)
      (mapcar 'vla-delete lst2)
      (vla-delete tmp)
      (mapcar (function (lambda (x) (vla-put-Lock x :vlax-true)))
      lck
      )
      (vla-EndUndoMark *acdoc*)
    )
  )
  (princ)
)

@+

[T.Willey]

It's possible.

Just select the attribute,
then get the name of the block that it is associated with,
then grab all the blocks,
step through the blocks to the attribute desired,
then move said attribute.

Edit:  Totally misunderstood the question, but it is possible.

Select the block,
enter distance and angle to move,
then step through the attributes and move them by distance and angle.

[Pad]

Thanks for all your answers, but I don't think I'm explaining myself very well.

I do not wish to move attributes globally, throughout the entire drawing, but instead locally one block at a time.

The 2 lisps attached do a very good job.
MOVEATTXT - moves one attribute on one block at a time, its a quick way of selecting an individual attribute and moving it without messing with grips.
MOVEATTEXT - works in a very similar way but allows the selection of more one attribute on an individual block.

I'm hoping to modify MOVEATTEXT so that it will select all the attributes on just the selected individual block, the reason being that sometimes in congested areas it can be difficult to select the attributes of a block without accidentally selecting another blocks attribute by mistake.

Thanks
Pads

[cadplayer]

I was inspired do little bit more 

Code: [Select]

(defun C:MoveAtt (/
                  doc
                  x
                  att
                  dis
                  rot
                  )
  (vl-load-com)
  (princ "\nMove selected Attributes")
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (cond
    ((ssget (list (cons 0 "INSERT")))
     (setq dis (getdist "\nType in value for move selected Attributes\n<[Up] +value> <[Down] -value>: "))
     (vlax-for item (vla-get-ActiveSelectionSet doc)
       (cond
         ((= (vla-get-HasAttributes item) :vlax-true)
          (setq att (variant-value (vla-getattributes item)))
          (foreach x (safearray-value att)
            (setq rot (vla-get-rotation x))
            (vla-put-insertionpoint x
                                    (vlax-3d-point
                                      (polar
                                          (safearray-value
                                            (variant-value
                                              (vla-get-insertionpoint x)
                                              )
                                           )

                                          (+ rot (/ pi 2)); angle in radians
                                          dis ; distance to move
                                          )
                                        )
               )
            )
          (vla-update item))
         ((princ "\nNo blocks in drawing"))))))
  (vla-endundomark doc)
  (princ)
  )

(defun c:MA () (C:MoveAtt))

[Hugo]

Hallo cadplayer

What does that do for me nothing happens.

Was soll das machen bei mir passiert gar nichts.

[cadplayer]

Try it with my block. The code changes only position from Attribute in up down direction

[Hugo]

OK works
Thank you


OK funktioniert
Danke