Aller au contenu

Amélioration du lisp move-att.lsp


pelloux
 Partager

Messages recommandés

Bonjour

 

J'utilise le lisp de Gile "move-att.lsp" qui me sert à bouger les attributs de blocs. Toutefois je souhaiterais pouvoir visualiser les attributs au moment où je les déplace (ex : attributs en pointillés).

 

L'objectif est d'être plus précis dans entre le point de départ et le point d'arrivée du déplacement des attributs.

 

Quelqu'un connaît les quelques lignes à rajouter dans le code ci dessous pour arriver à ce résulat :

 

Merci.

 

Paul-Henri PELLOUX

 

(defun c:move-att (/ ss p1 p2 dep)
(vl-load-com)
(if (and
(setq ss (ssget '((0 . "INSERT") (66 . 1))))
(setq p1 (getpoint "\nSpécifiez le point de base: "))
(setq p2 (getpoint p1 "Spécifiez le deuxième point: "))
)
(progn
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark acdoc)
(vlax-for ref (vla-get-ActiveSelectionSet acdoc)
(if (setq att (vlax-invoke ref 'getAttributes))
(foreach a att
(vla-move a (vlax-3d-point p1) (vlax-3d-point p2))
)
)
)
(vla-EndUndoMark acdoc)
)
)
(princ)
)

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

J'ai essayé un subterfuge, ce n'est pas très élégant, mais ça semble fonctionner.

 

MOVE-ATT déplace tous les attributs contenus dans les blocs sélectionnés

 

;; MOVE-ATT (gile)
;; Déplace tous les attributs des blocs sélectionnés

(defun c:move-att (/ acdoc space ss1 ss2 att txt lst1 lst2 p1 p2)
 (vl-load-com)
 (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
    space (if (= 1 (getvar "cvport"))
	    (vla-get-PaperSpace acdoc)
	    (vla-get-ModelSpace acdoc)
	  )
    ss2	  (ssadd)
     )
     (vla-StartUndoMark acdoc)
     (vlax-for	ref (setq ss1 (vla-get-ActiveSelectionSet acdoc))
(if (setq att (vlax-invoke ref 'getAttributes))
  (foreach a att
    (setq txt
	   (vla-addText
	     space
	     (vla-get-TextString a)
	     (vla-get-InsertionPoint a)
	     (vla-get-Height a)
	   )
    )
    (foreach prop '(Alignment	    Backward
		    Layer	    Linetype
		    LinetypeScale   Normal
		    ObliqueAngle    Rotation
		    ScaleFactor	    StyleName
		    TextAlignmentPoint
		    Thickness	    TrueColor
		    UpsideDown
		   )
      (if (vlax-property-available-p a prop)
	(vlax-put txt prop (vlax-get a prop))
      )
    )
    (setq ss2 (ssadd (vlax-vla-object->ename txt) ss2))
    (setq lst1 (cons a lst1))
    (setq lst2 (cons txt lst2))
  )
)
     )
     (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda ()
	 (setq p1 (getpoint "\nSpécifiez le point de base: "))
	 (vl-cmdf "_.move" ss2 "" p1 pause)
	 (setq p2 (getvar "lastpoint"))
       )
    )
  )
)
 (mapcar '(lambda (a)
	    (vla-move a
		      (vlax-3d-point (trans p1 1 0))
		      (vlax-3d-point (trans p2 1 0))
	    )
	  )
	 lst1
 )
     )
     (mapcar 'vla-delete lst2)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
) 

 

MOVE_ATT déplace tous les attributs sélectionnés un par un

 

(defun c:move_att (/ acdoc space att lst1 lst2 ss2 txt p1 p2)
 (vl-load-com)
 (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
     (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
    space (if (= 1 (getvar "cvport"))
	    (vla-get-PaperSpace acdoc)
	    (vla-get-ModelSpace acdoc)
	  )
    ss2	  (ssadd)
     )
     (vla-StartUndoMark acdoc)
     (foreach a lst1
(setq txt
       (vla-addText
	 space
	 (vla-get-TextString a)
	 (vla-get-InsertionPoint a)
	 (vla-get-Height a)
       )
)
(foreach prop '(Alignment	Backward	Layer
		Linetype	LinetypeScale	Normal
		ObliqueAngle	Rotation	ScaleFactor
		StyleName	TextAlignmentPoint
		Thickness	TrueColor	UpsideDown
	       )
  (if (vlax-property-available-p a prop)
    (vlax-put txt prop (vlax-get a prop))
  )
)
(setq ss2 (ssadd (vlax-vla-object->ename txt) ss2))
(setq lst2 (cons txt lst2))
     )
     (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda ()
	 (setq p1 (getpoint "\nSpécifiez le point de base: "))
	 (vl-cmdf "_.move" ss2 "" p1 pause)
	 (setq p2 (getvar "lastpoint"))
       )
    )
  )
)
 (mapcar '(lambda (a)
	    (vla-move a
		      (vlax-3d-point (trans p1 1 0))
		      (vlax-3d-point (trans p2 1 0))
	    )
	  )
	 lst1
 )
     )
     (mapcar 'vla-delete lst2)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
) 

[Edité le 29/4/2008 par (gile)]

 

[Edité le 30/4/2008 par (gile)]

  • Like 1

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Bonjour Gile

 

Je ne veux pas abuser de ton temps mais j'ai essayé ta première amélioration sur Autocad 2008 et il me donne dans la 1ère modification un message d'erreur après :

 

Commande: move-att

Choix des objets: 1 trouvé(s)

Choix des objets:

; erreur: AutoCAD.Application: Non valable

Commande:

 

... et dans le 2ième un nouveau message d'erreur :

 

- Commande: move_att

Sélectionnez un attribut: ; erreur: no function definition:

VLAX-ENAME->VLA-OBJECT

Commande:

 

Merci

 

Paul-Henri PELLOUX

Lien vers le commentaire
Partager sur d’autres sites

Ok mais ça me met toujours un message d'erreur

 

Je viens de rajouter (vl-load-com) comme ceci :

 

(defun c:move_att (/ acdoc space att lst1 lst2 ss2 txt p1 p2)
(vl-load-com)
(while (setq att (car (nentsel "\nSélectionnez un attribut: ")))
(and

 

et cette fois j'ai ça (après avoir sélectionner 3 attributs) :

 

Commande: move_att

Sélectionnez un attribut:

Sélectionnez un attribut:

Sélectionnez un attribut:

Sélectionnez un attribut:

; erreur: AutoCAD.Application: Non valable

Commande:

 

PHP

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Je ne vois pas bien d'où ça peut venir.

J'ai modifié la syntaxe de quelques expressions : (getvar "cvport") à la place de (getvar 'cvport) au cas où cette dernière ne serait pas reconnue par AutoCAD 2008 (mais ça m'étonnerait).

 

Je te propose d'essayer de localiser l'erreur (si tu as un peu de temps)

Dans l'éditeur Visual LISP (commande VLIDE), tu ouvres une nouvelle fenêtre (CTRL+N), tu colles le code dans la fenêtre, tu le charges dans le dessin (CTRL+ALT+E), dans le menu "Débogage", tu coches "Arrêt sur erreur", tu retournes dans la fenêtre AutoCAD sans fermer l'éditeur et tu lance la commande.

Au moment de l'erreur, l'editeur Visual LISP redevient actif, tu fais CTRL+F9 et l'expression qui a causé l'erreur est sélectionnée (elle se met en surbrillance) tu peux la copier et la poster ici.

Pour revenir à la normale, tu décoches "Arrêt sur erreur" dans le menu "Débogage" et tu cliques sur l'icône "Réinitialiser" (flèche rouge).

 

Tu trouveras ici un sujet sur l'utilisation de l'éditeur Visual LISP et à la Réponse 4 les outils de débogage.

  • Like 1

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Bonjour

 

Dans l'éditeur du Visual Lisp, en faisant CRTL+ALT+F9, je n'ai pas eu d'expression surlignée mais mais l'ouverture d'une boite "Infos" avec le message suivant :

 

:ERROR BREAK AutoCAD.Application: Non valable

 

C'est tout.

 

PHP

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Je ne vois toujours pas d'où ça peut venir, probablement d'une nouveauté 2008 (j'ai fait des tests sur 2006 et 2007, pas de problème). Je pense à ces "fameuses" échelles d'annotations.

 

Pourrais tu entrer l'expression suivante, et sélectionner un attribut, puis refaire la manip en sélectionnant un texte simple et poster les résultats ?

 

(vlax-dump-object (vlax-ename->vla-object (car (nentsel)))) 

 

EDIT: Le fait que ça fonctionne chez lili2006, qui, je crois bien, utilise 2008 aussi, remet en question ce qui est dit ci-dessus.

 

Tu peux essayer de mettre un point d'arrêt juste devant (setq txt (vla-addText ...)) et de faire un "Pas à pas principal" ou un "Pas à pas détaillé" pour localiser l'erreur (voir le lien concernant l'éditeur Visual LISP).

 

[Edité le 5/5/2008 par (gile)]

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Suite a un test avec la ligne vlisp voici le résultat du dumping sur un AutoCAD MAP 2005 :

 

Commande: (vlax-dump-object (vlax-ename->vla-object (car (nentsel))))

 

Choix de l'objet: ; IAcadAttributeReference: Interface AutoCAD Attribute Reference ; Valeurs de propriétés:

; Alignment = 1

; Application (RO) = #

; Backward = 0

; Constant (RO) = 0

; Document (RO) = #

; FieldLength = 0

; Handle (RO) = "9D"

; HasExtensionDictionary (RO) = 0

; Height = 1.25

; Hyperlinks (RO) = #

; InsertionPoint = (511663.0 1.18871e+006 0.0)

; Invisible = 0

; Layer = "LONGEP"

; Linetype = "ByLayer"

; LinetypeScale = 1.0

; Lineweight = -1

; Normal = (0.0 0.0 1.0)

; ObjectID (RO) = 2130243880

; ObjectName (RO) = "AcDbAttribute"

; ObliqueAngle = 0.0

; OwnerID (RO) = 2130190184

; PlotStyleName = "ByLayer"

; Rotation = 0.42483

; ScaleFactor = 1.0

; StyleName = "Standard"

; TagString = "DIAMETRE_LONGUEUR"

; TextAlignmentPoint = (511666.0 1.18871e+006 0.0)

; TextGenerationFlag = 0

; TextString = "d...? ...?m"

; Thickness = 0.0

; TrueColor = #

; UpsideDown = 0

; Visible = -1

T

 

Si ca peut aider !

 

Lien vers le commentaire
Partager sur d’autres sites

Oupss !!!

 

Encore le même oubli, avant d'utiliser les fonctions Visual LISP dans une session il faut les charger en faisant (vl-load-com)

 

PS : Je ne suis plus disponible jusqu'à ce soir, je verrais ça à ce moment là.

 

[Edité le 5/5/2008 par (gile)]

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

On progresse, voici ce que j'ai :

 

Commande: (vl-load-com)
Commande: (vlax-dump-object (vlax-ename->vla-object (car (nentsel))))
Choix de l'objet: ; IAcadAttributeReference2: Interface AutoCAD Attribute 
Reference
; Valeurs de propriétés:
;   Alignment = 0
;   Application (RO) = #
;   Backward = 0
;   Constant (RO) = 0
;   Document (RO) = #
;   FieldLength = 0
;   Handle (RO) = "92"
;   HasExtensionDictionary (RO) = 0
;   Height = 1.25
;   Hyperlinks (RO) = #
;   InsertionPoint = (511662.0 1.18872e+006 0.0)
;   Invisible = 0
;   Layer = "TEXTEP"
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   LockPosition (RO) = 0
;   Material = "ByLayer"
;   MTextAttribute = 0
;   MTextAttributeContent = ""
;   MTextBoundaryWidth = 0.0
;   MTextDrawingDirection = 5
;   Normal = (0.0 0.0 1.0)
;   ObjectID (RO) = 2130587856
;   ObjectName (RO) = "AcDbAttribute"
;   ObliqueAngle = 0.0
;   OwnerID (RO) = 2130583400
;   PlotStyleName = "ByLayer"
;   Rotation = 0.0
;   ScaleFactor = 1.0
;   StyleName = "Standard"
;   TagString = "ALTITUDERGD"
;   TextAlignmentPoint = (0.0 0.0 0.0)
;   TextGenerationFlag = 0
;   TextString = "TP ...?..."
;   Thickness = 0.0
;   TrueColor = #
;   UpsideDown = 0
;   Visible = -1
T

 

Merci

 

PHP

Lien vers le commentaire
Partager sur d’autres sites

Bonsoir à toutes et tous,

 

Sur une V2008 =>

 

Commande: MOVE-ATT1

Choix des objets: Spécifiez le coin opposé: 2 trouvé(s)

Choix des objets:

Spécifiez le point de base: _.move

Choix des objets: 2 trouvé(s)

Choix des objets:

Spécifiez le point de base ou [Déplacement] : Spécifiez le

deuxième point ou :

Commande:

Commande:

Commande:

Commande: move_att2

Sélectionnez un attribut:

Sélectionnez un attribut:

Spécifiez le point de base: _.move

Choix des objets: 1 trouvé(s)

Choix des objets:

Spécifiez le point de base ou [Déplacement] : Spécifiez le

deuxième point ou :

Commande:

 

(gile), je confirme, ça marche !

 

Civil 3D 2023 - COVADIS_18.0a

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites

Pour ceux qui ont le message d'erreur,

 

Je propose un test "à l"ancienne" pour essayer de localiser l'erreur.

J'ai parsemé la routine de boites d'alerte numérotée, il s'agirait de la lancer, de choisir un seul attribut, de faire OK à chaque boite qui s'ouvre et de noter le numéro de la dernière boite avant l'erreur.

 

(defun c:move_att (/ acdoc space att lst1 lst2 ss2 txt p1 p2)
 (vl-load-com)
 (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
     (alert "1")
     (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
    space (if (= 1 (getvar "cvport"))
	    (vla-get-PaperSpace acdoc)
	    (vla-get-ModelSpace acdoc)
	  )
    ss2	  (ssadd)
     )
     (alert "2")
     (vla-StartUndoMark acdoc)
     (foreach a lst1
(alert "3")
(setq txt
       (vla-addText
	 space
	 (vla-get-TextString a)
	 (vla-get-InsertionPoint a)
	 (vla-get-Height a)
       )
)
(alert "4")
(foreach prop '(Alignment	Backward	Layer
		Linetype	LinetypeScale	Normal
		ObliqueAngle	Rotation	ScaleFactor
		StyleName	TextAlignmentPoint
		Thickness	TrueColor	UpsideDown
	       )
  (if (vlax-property-available-p a prop)
    (vlax-put txt prop (vlax-get a prop))
  )
)
(alert "5")
(setq ss2 (ssadd (vlax-vla-object->ename txt) ss2))
(setq lst2 (cons txt lst2))
     )
     (alert "6")
     (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda ()
	 (setq p1 (getpoint "\nSpécifiez le point de base: "))
	 (vl-cmdf "_.move" ss2 "" p1 pause)
	 (setq p2 (getvar "lastpoint"))
       )
    )
  )
)
 (mapcar '(lambda (a)
	    (vla-move a
		      (vlax-3d-point (trans p1 1 0))
		      (vlax-3d-point (trans p2 1 0))
	    )
	  )
	 lst1
 )
     )
     (alert "7")
     (mapcar 'vla-delete lst2)
     (vla-EndUndoMark acdoc)
     (alert "OK")
   )
 )
 (princ)
) 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Salut (gile),

j'ai aussi l'erreur (sous 2009)

je jeté un coup d'œil, et il me semble que le problème viens de là :

 (foreach prop '(Alignment Backward Layer
Linetype LinetypeScale Normal
ObliqueAngle Rotation ScaleFactor
StyleName TextAlignmentPoint
Thickness TrueColor UpsideDown
)
[b](if (vlax-property-available-p a prop)
(vlax-put txt prop (vlax-get a prop))
)[/b]
)

et plus précisément du "(vlax-put txt prop" car si au lieu de ça je demande simplement (princ (vlax-get a prop)) il me sort bien les valeurs.

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

Lien vers le commentaire
Partager sur d’autres sites

 

Hello Gilles

 

Sur mon MAP 2008 et aussi sur mon MAP 2007, je me casse la figure apres le 4 !

 

Ce qui est amusant, c'est que je dois cliquer avec le bouton droit de la souris APRES

avoir sélectionné UN attribut et non pas taper sur :casstet:

 

Autre truc rigolo, mon dessin de test utilise des blocs avec des attributs TOUS invisibles,

je fais donc un ATTECRAN = ACtif puis REGEN (par scurité) pour les voir tous ...

 

L'attribut (ou un autre) que je choisis pour tester "MOVE_ATT" DEVIENT UN TEXTE après l'erreur AutoCAD dans "move_att.lsp" !!! Gilles, tu peux m'expliquer ??

 

Je peux jouer tant que je veux avec ATTECRAN et REGEN, c'est un joli texte simple

après le plantage !

 

Le Decapode "intrigué"

 

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

L'attribut (ou un autre) que je choisis pour tester "MOVE_ATT" DEVIENT UN TEXTE après l'erreur AutoCAD dans "move_att.lsp"

 

C'est normal, la demande de pelloux était de voir l'attribut lors du déplacement, le subterfuge consiste à créer un texte avec les mêmes propriétés que l'attribut et de délacer ce texte avec la commande DEPLACER d'autoCAD, les points de base et de déplacement étant récupérés l'attribut est déplacé et le texte effacé.

Comme il semble que la routine plante au moment où les propriétés de l'attribut sont affectées au texte (merci Bred), celui-ci n'est pas effacé.

 

J'ai ajouté un contrôle supplémentaire sur l'accessibilité des propriétés pour l'attribut et le texte.

En espérant que ça fonctionne pour tous désormais...

 

EDIT: Je pense avoir trouvé, ça viendrait de la propriété TextAlignmentPoint suivant la justification du texte.

 

EDIT 2 : Modification pour un fonctionnement dans les SCU pivotés sur les 3 axes

 

;; MOVE-ATT (gile)
;; Déplace tous les attributs des blocs sélectionnés

(defun c:move-att (/ acdoc space ss1 ss2 att txt lst1 lst2 p1 p2)
 (vl-load-com)
 (if (ssget '((0 . "INSERT") (66 . 1)))
   (progn
     (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
    space (if (= 1 (getvar "cvport"))
	    (vla-get-PaperSpace acdoc)
	    (vla-get-ModelSpace acdoc)
	  )
    ss2	  (ssadd)
     )
     (vla-StartUndoMark acdoc)
     (vlax-for	ref (setq ss1 (vla-get-ActiveSelectionSet acdoc))
(if (setq att (vlax-invoke ref 'getAttributes))
  (foreach a att
    (setq txt
	   (vla-addText
	     space
	     (vla-get-TextString a)
	     (vla-get-InsertionPoint a)
	     (vla-get-Height a)
	   )
    )
    (foreach prop '(Alignment	  Backward	Layer
		    Linetype	  LinetypeScale	Normal
		    ObliqueAngle  Rotation	ScaleFactor
		    StyleName	  Thickness	TrueColor
		    UpsideDown
		   )
      (if (and
	    (vlax-property-available-p a prop)
	    (vlax-property-available-p txt prop T)
	  )
	(vlax-put-property txt prop (vlax-get-property a prop))
      )
    )
    (if	(= (vla-get-Alignment a) 0)
      (vla-put-InsertionPoint
	txt
	(vla-get-InsertionPoint a)
      )
      (vla-put-TextAlignmentPoint
	txt
	(vla-get-TextAlignmentPoint a)
      )
    )
    (setq ss2 (ssadd (vlax-vla-object->ename txt) ss2))
    (setq lst1 (cons a lst1))
    (setq lst2 (cons txt lst2))
  )
)
     )
     (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda ()
	 (setq p1 (getpoint "\nSpécifiez le point de base: "))
	 (vl-cmdf "_.move" ss2 "" p1 pause)
	 (setq p2 (getvar "lastpoint"))
       )
    )
  )
)
 (mapcar '(lambda (a)
	    (vla-move a
		      (vlax-3d-point (trans p1 1 0))
		      (vlax-3d-point (trans p2 1 0))
	    )
	  )
	 lst1
 )
     )
     (mapcar 'vla-delete lst2)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
)



;; MOVE_ATT (gile)
;; déplace tous les attributs sélectionnés un par un

(defun c:move_att (/ acdoc space att lst1 lst2 ss2 txt p1 p2)
 (vl-load-com)
 (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
     (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
    space (if (= 1 (getvar "cvport"))
	    (vla-get-PaperSpace acdoc)
	    (vla-get-ModelSpace acdoc)
	  )
    ss2	  (ssadd)
     )
     (vla-StartUndoMark acdoc)
     (foreach a lst1
(setq txt
       (vla-addText
	 space
	 (vla-get-TextString a)
	 (vla-get-InsertionPoint a)
	 (vla-get-Height a)
       )
)
(foreach prop '(Alignment     Backward	    Layer
		Linetype      LinetypeScale Normal
		ObliqueAngle  Rotation	    ScaleFactor
		StyleName     Thickness	    TrueColor
		UpsideDown
	       )
  (if (and
	(vlax-property-available-p a prop)
	(vlax-property-available-p txt prop T)
      )
    (vlax-put-property txt prop (vlax-get-property a prop))
  )
)
(if (= (vla-get-Alignment a) 0)
  (vla-put-InsertionPoint
    txt
    (vla-get-InsertionPoint a)
  )
  (vla-put-TextAlignmentPoint
    txt
    (vla-get-TextAlignmentPoint a)
  )
)
(setq ss2 (ssadd (vlax-vla-object->ename txt) ss2))
(setq lst2 (cons txt lst2))
     )
     (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda ()
	 (setq p1 (getpoint "\nSpécifiez le point de base: "))
	 (vl-cmdf "_.move" ss2 "" p1 pause)
	 (setq p2 (getvar "lastpoint"))
       )
    )
  )
)
 (mapcar '(lambda (a)
	    (vla-move a
		      (vlax-3d-point (trans p1 1 0))
		      (vlax-3d-point (trans p2 1 0))
	    )
	  )
	 lst1
 )
     )
     (mapcar 'vla-delete lst2)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
) 

[Edité le 5/5/2008 par (gile)]

 

[Edité le 6/5/2008 par (gile)]

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Bonsoir

 

(gile)

J'ai testé ton lisp sur une 2009 et il fonctionne sans erreurs.

Par contre, je ne vois pas les attributs, mais uniquement la ligne de déplacement lors du l'action de déplacement.

 

A la recherche du bug perdu ;)

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager

×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité