Author Topic: Lisp to move attributes  (Read 18082 times)

0 Members and 2 Guests are viewing this topic.

Aerdvark

  • Guest
Re: Lisp to move attributes
« Reply #30 on: November 03, 2009, 10:46:30 AM »

Pad

  • Bull Frog
  • Posts: 329
Re: Lisp to move attributes
« Reply #31 on: November 03, 2009, 11:03:12 AM »
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

  • Bull Frog
  • Posts: 276
  • Rennes, France
Re: Lisp to move attributes
« Reply #32 on: November 03, 2009, 11:08:43 AM »
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)
)

@+
The shape even of the pyramids of Egypt shows that already the workmen tended to make some less and less.
Will Cuppy, 1884-1949.

T.Willey

  • Needs a day job
  • Posts: 5247
Re: Lisp to move attributes
« Reply #33 on: November 03, 2009, 11:08:57 AM »
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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Pad

  • Bull Frog
  • Posts: 329
Re: Lisp to move attributes
« Reply #34 on: November 03, 2009, 11:25:28 AM »
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

  • Bull Frog
  • Posts: 389
  • Autocad Civil3d, OpenDCL.Runtime, LISP, .NET (C#)
Re: Lisp to move attributes
« Reply #35 on: December 13, 2012, 04:01:40 AM »
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

  • Bull Frog
  • Posts: 340
Re: Lisp to move attributes
« Reply #36 on: December 13, 2012, 05:18:11 AM »
Hallo cadplayer

What does that do for me nothing happens.

Was soll das machen bei mir passiert gar nichts.

cadplayer

  • Bull Frog
  • Posts: 389
  • Autocad Civil3d, OpenDCL.Runtime, LISP, .NET (C#)
Re: Lisp to move attributes
« Reply #37 on: December 13, 2012, 05:35:53 AM »
Try it with my block. The code changes only position from Attribute in up down direction
« Last Edit: December 13, 2012, 05:40:42 AM by cadplayer »

Hugo

  • Bull Frog
  • Posts: 340
Re: Lisp to move attributes
« Reply #38 on: December 13, 2012, 05:53:33 AM »
OK works
Thank you


OK funktioniert
Danke
« Last Edit: December 13, 2012, 06:06:27 AM by Hugo »