Aller au contenu

ATT to Mleader


nG! Hebus

Messages recommandés

Bonjour,

 

Est ce qu'une bonne ame pourrait faire un mix entre ces deux lisp :

 

(defun c:BNameLabel (/ ent entl obj)
 (cond ((not (setq ent (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget ent))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (not (equal entl (setq entl (entlast))))
          (vla-put-textstring
            (vlax-ename->vla-object entl)
            (vlax-get-property
              (setq obj (vlax-ename->vla-object ent))
              (if (vlax-property-available-p obj 'EffectiveName)
                'EffectiveName
                'Name
              )
            )
          )
        )
       )
 )
 (princ)
)
(vl-load-com)
(princ)

 

;; 
;; https://autocadtips1.com/2011/04/26/autolisp-attribute-to-text-mtext/
;; 
;; Routine: ATT2MT - Convert Attribute to MText ...
;; 
;; The routine ATT2MT asks for text height ... 
;; Then you can select MANY Blocks with Attributes
;; ALL Attributes will be written as a MText of N Lines
;; 

;;;;;; 
:;;;; Written by Smirnoff
;;;;;  
;;;;; Found @ http://www.cadtutor.net/forum/showthread.php?56833-Display-ATTRIBUTES-as-Text-from-multiple-blocks&highlight=attmt
;;;;;  


(defun c:Att2MT(/ aDoc aSp oSiz bSet aLst cLst tStr nTxt bCtr Tags TextInsert)

; *****************************************************************************

; ADJUSTMENTS ;

; (Modify it to adjust for your own requirements) ;

; *****************************************************************************

(setq Tags T) ; - if T add tags to MText if Nil not

(setq TextInsert T) ; - Text insertion point. If T center of Bounding Box

; of block, if Nil Block insertion point.

; ******************************* END ADJUSTMENTS *****************************

(vl-load-com)

(defun GetBoundingCenter (vlaObj / blPt trPt cnPt)

(vla-GetBoundingBox vlaObj 'minPt 'maxPt)

(setq blPt(vlax-safearray->list minPt)

trPt(vlax-safearray->list maxPt)

cnPt(vlax-3D-point

(list

(+(car blPt)(/(-(car trPt)(car blPt))2))

(+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))

0.0

); end list

); end vlax-3D-point

); end setq

); end of GetBoundingCenter

(if(not attmt:Size)(setq attmt:Size(getvar "TEXTSIZE")))

(setq oSiz attmt:Size

attmt:Size(getreal(strcat "\nText size <"(rtos attmt:Size)">: ")))

(if(null attmt:Size)(setq attmt:Size oSiz))

(setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)))

(if(= 1(vla-get-ActiveSpace aDoc))

(setq aSp(vla-get-ModelSpace aDoc))

(setq aSp(vla-get-PaperSpace aDoc))

); end if

(princ "\n<<< Select Text to extract Attributes to MText >>> ")

(if(setq bSet(ssget '((0 . "INSERT"))))

(progn

(foreach b(mapcar 'vlax-ename->vla-object

(vl-remove-if 'listp

(mapcar 'cadr(ssnamex bSet))))

(setq aLst '()

tStr "") ; end setq

(if TextInsert

(setq bCtr(GetBoundingCenter B))

(setq bCtr(vla-get-InsertionPoint B))

); end if

(if(= :vlax-true(vla-get-HasAttributes B))

(progn

(setq aLst

(mapcar '(lambda (a)

(list (vla-get-TagString a)

(vla-get-TextString a)))

(vlax-safearray->list

(vlax-variant-value(vla-GetAttributes B)))))

(foreach i(reverse aLst)

(setq tStr(strcat tStr(if Tags(strcat(car i) ": ")"")(last i)"\\P"))

); end foreach

(if(/= "" tStr)

(progn

(setq nTxt(vla-AddMText aSp bCtr (* attmt:Size 30.0) tStr))

(vla-put-Height nTxt attmt:Size)

); end progn

); end if

); end progn

); end if

); end foreach

(vla-EndUndoMark aDoc)

); end progn

); end if

(princ)

); end of c:att2mt 

 

le but est d'extraire un attribut toujours le même, nommé "REPERE", dans un bloc.

Merci d'avance pour ceux qui passeront du temps dessus.

 

Cordialement

 

 

PS : Sujet de base

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Salut

 

A partir de ce lisp

(defun c:atm(/ att doc ent grr new pt1 pt2 mlead gc:3dPointListToVariant)
 (defun gc:3dPointListToVariant (lst)
   (vlax-make-variant
     (vlax-safearray-fill
(vlax-make-safearray
         vlax-VbDouble
  (cons 0 (1- (* 3 (length lst))))
)
(apply 'append lst)
     )
   )
 )

 (defun mlead(pt2 / pts)
   (setq pts (gc:3dPointListToVariant (list (trans pt1 1 0) (trans pt2 1 0))))
   (if new
     (progn
(vla-setleaderlinevertices new 0 pts)
(vla-setdoglegdirection new 0 (vlax-3D-point (trans (list (if (> (car pt2) (car pt1)) 1 -1) 0 0) 1 0 T)))
(vla-update new)
     )
     (progn
(setq new (vla-addmleader (vla-get-modelspace doc) pts 0))
(vla-put-textstring new att)
(vla-rotate new (vlax-3d-point (trans pt2 1 0))
		(angle (trans '(0 0 0) 1 0) (trans '(1 0 0) 1 0))
)
     )
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (while (setq ent (entsel "\nSélectionnez un bloc : "))
   (and (setq ent (vlax-ename->vla-object (car ent)))
 (eq (vla-get-objectname ent) "AcDbBlockReference")
 (eq (vla-get-hasattributes ent) :vlax-true)
 (setq att (vl-remove-if-not '(lambda(x)(eq (strcase (vla-get-tagstring x)) "REPERE")) (vlax-invoke ent 'getattributes)))
 (setq att (vla-get-textstring (car att)))
 (setq pt1 (getpoint "\n1er point : "))
 (setq new nil pt2 pt1)
 (princ "\n2em point : ")
     (while (and pt2
	  (setq grr (grread t 9 0))
	  (vl-position (car grr) '(2 3 5))
     )
(cond
	  ((= (car grr) 3)(setq pt2 nil))
  ((= (car grr) 5)(mlead (cadr grr)))
	  (T  (setq pt2 nil)(if new (vla-delete new)))
)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

@+

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

Salut Patrick,

 

Merci c'est nickel, juste est ce qu'il est possible de mettre le placer suivant le SCU courant et non le SCUg?

 

Je l'aurai bien tenté mais je ne sais pas retrouvé le bout de LISP qui fait que tu le bloque sur le SCUg.

 

Merci d'avance

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Bah non le SCU est en général...

 

même en le changeant à la main :unsure:

 

je met un screencast pour montrer des fois que je fait mal quelque chose.

 

J'ai fait le test avec "BNameLabel" est pas de soucis de SCU, mais avec ATM soucis de SCU, je ne comprend pas trop d'ou ça viens, SNIIFF!

 

Lien screencast : https://knowledge.autodesk.com/community/screencast/08f35630-6e01-40df-9431-231507fd7a33

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Alors en gros, cela doit donner environ ça :

 

http://image.noelshack.com/fichiers/2016/34/1471878183-capture.jpg

 

Je met mes Mleader dans l'espace objet, le reste est issue d'une extraction de données et du LISP TUY de usegomme.

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Le lisp corrigé

(defun c:atm(/ att doc ent grr new pt1 pt2 mlead)
 (defun mlead(pt2 / pts)
   (setq pt2 (list (car pt2) (cadr pt2) (caddr pt1))
  pts (append (trans pt1 1 0) (trans pt2 1 0))
   )
   (if new
     (progn
(vlax-invoke new 'setleaderlinevertices 0 pts)
(vla-setdoglegdirection new 0 (vlax-3D-point (trans (list (if (> (car pt2) (car pt1)) 1 -1) 0 0) 1 0 T)))
(vla-update new)
     )
     (progn
(setq new (vlax-invoke (vla-get-modelspace doc) 'addmleader pts 0))
(vla-put-textstring new att)
(vla-rotate new (vlax-3d-point (trans pt2 1 0))
		(angle (trans '(0 0 0) 1 0) (trans '(1 0 0) 1 0))
)
(setq pts (vlax-invoke new 'getleaderlinevertices 0))
(vlax-invoke new 'move	(trans (list 0.0 0.0 (last  pts)) 1 0)
			(trans (list 0.0 0.0 (caddr pt2)) 1 0)
)
     )
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (while (setq ent (entsel "\nSélectionnez un bloc : "))
   (and (setq ent (vlax-ename->vla-object (car ent)))
 (eq (vla-get-objectname ent) "AcDbBlockReference")
 (eq (vla-get-hasattributes ent) :vlax-true)
 (setq att (vl-remove-if-not '(lambda(x)(eq (strcase (vla-get-tagstring x)) "REPERE")) (vlax-invoke ent 'getattributes)))
 (setq att (vla-get-textstring (car att)))
 (setq pt1 (getpoint "\n1er point : "))
 (setq new nil pt2 pt1)
 (princ "\n2em point : ")
     (while (and pt2
	  (setq grr (grread t 9 0))
	  (vl-position (car grr) '(2 3 5))
     )
(cond
	  ((= (car grr) 3)(setq pt2 nil))
  ((= (car grr) 5)(mlead (cadr grr)))
	  (T  (setq pt2 nil)(if new (vla-delete new)))
)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

@+

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

Salut Patrick,

 

Toujours le même soucis...

 

et en partant de ce LISP?

 

(defun c:BNameLabel (/ ent entl obj)
 (cond ((not (setq ent (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget ent))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (not (equal entl (setq entl (entlast))))
          (vla-put-textstring
            (vlax-ename->vla-object entl)
            (vlax-get-property
              (setq obj (vlax-ename->vla-object ent))
              (if (vlax-property-available-p obj 'EffectiveName)
                'EffectiveName
                'Name
              )
            )
          )
        )
       )
 )
 (princ)
)
(vl-load-com)
(princ)

 

 

Car aucun soucis avec celui ci, mais je n'arrive pas à voir comment le modifier :huh:

 

 

j'ai essayé un truc du genre :

 

(defun c:BNameLabel (/ ent entl obj)
 (cond ((not (setq ent (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget ent))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (not (equal entl (setq entl (entlast))))
          (vla-put-textstring
            (vlax-ename->vla-object entl)
            (vlax-get-property
              (setq obj (vlax-ename->get-tagstring x)) "REPERE"))
              (if (vlax-invoke ent 'getattributes)
                'getattributes
                'REPERE
              )
            )
          )
        )
       )
 )
 (princ)
)
(vl-load-com)
(princ)

 

Mais ça fonctionne pas :(

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Le lisp modifié pour répondre à ta demande

 

(defun c:BNameLabel (/ ent entl obj)
 (cond ((not (setq ent (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget ent))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast))
 (setq att (vl-remove-if-not '(lambda(x)(eq (strcase (vla-get-tagstring x)) "REPERE")) (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (not (equal entl (setq entl (entlast))))
   (vla-put-textstring (vlax-ename->vla-object entl) (vla-get-textstring (car att)))
        )
       )
 )
 (princ)
)

 

Mais je ne comprends pas. Celui que je t'ai donné devrait fonctionner ?

 

@+

  • Upvote 1

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

YEEEEAAAH, merci c'est impec'.

 

Pour ce qui est du premier LISP fournis, je ne comprend pas (j'essaye d'apprendre à lire mais il y a des fonctions que je ne connais pas).

 

Faut que je m'y mette, car à chaque fois je demande de l'aide en LISP...

Je me sens utile sur ce forum seulement quand une personne pose une question sur AutoCAD 3D...

 

Encore merci d'avoir passé du temps ( à qui j'envoi la facture? :P )

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Faut que je m'y mette, car à chaque fois je demande de l'aide en LISP...

Ben, tu sais ce qu'il te reste à faire ;)

 

Je me sens utile sur ce forum seulement quand une personne pose une question sur AutoCAD 3D...

Je suis certain qu'il y a d'autres domaines

 

Encore merci d'avoir passé du temps ( à qui j'envoi la facture? :P )

De rien, je ne suis pas contre une bière :D

 

@+

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

Tu crois que c'est possible de livrer de la bière?

 

Parce que le 35 c'est pas à coté :P

Pis par ici c'est plutôt le saucisson que la bière (y'a qu'en Belgique qu'on sais brasser :(rires forts): )

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Tu crois que c'est possible de livrer de la bière?

Pour ça, il n'y a jamais de problèmes B)

 

Pis par ici c'est plutôt le saucisson que la bière (y'a qu'en Belgique qu'on sais brasser <img src='http://cadxp.com/public/style_emoticons/<#EMO_DIR#>/laugh.gif' class='bbc_emoticon' alt=':(rires forts):' /> )

Sauf que les belges ont été voir les allemands pour alléger leurs bières, mais bon.

Il y a plusieurs pays qui savent brasser, même en France et en Bretagne :)

 

@+

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

ho non pas de la bière bavaroise (beurk !)

 

:P

 

Oui je sais y'a une brasserie coopérative pas loin de la ou je suis (la Biére du Pilat, PS: pas la Dune du pilat, la réserve naturelle du Pilat, "un beau p'tit coin ou y fait bon vivre, "raclement de gorge", **crache** ! Pour sur ! :P )

 

Oui les Bretons font même du Cola (Breizh Cola). Je vous envie les galettes et les fest-noz (mes premières cuites)

 

Mais mes Frites me manquent :unsure: ici la patate est pas bonne et c'est cuit dans l'huile végétal... "HOOOooo Friiites, hooo fricadelle, hoooo pluie quotidienne, tu me manque"

 

Sans déconné ici il pleut jamais, j'ai déménagé l'an dernier et y'a pas plu pendant 4 MOIS, c'est quoi cette région, quand y'a plu je suis sortis prendre l'eau...

 

PS : Je suis jamais content :P (Didier sors de ce corps, ho le vilain qui se moque :P )

 

 

 

 

 

**tente de passer la pinte par le Fax**, t'es sur que ça passe, j'ai un doute...Bah si un jour tu fait un saut à Lyon ou que je bouge en Bretagne ;)

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
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
×
×
  • 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é