Aller au contenu

Lisp pour ecrire un texte sur une ligne en fonction de la couleur


Maxime85

Messages recommandés

Bonsoir,

 

j aimerais avoir un lisp qui puisse m aider à ecrire soit le nom de la couleur ou du texte sur une ligne ceci en fonction de la couleur de chaque ligne / polyligne

 

Cordialement

 

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

j' ai plusieurs ligne sur autocad j aimerais mettre du texte sur chacune de ses lignes (par exemple le code couleur de chaque ligne ou un texte indiquant la couleur de chaque ligne )

 

je voudrais que cela soit automatique

 

lien :https://ibb.co/X56PwpD

 

cordialement

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

Comme le dit Didier, les champs sont bien indiqués pour cela.Si tu en as beaucoup à faire on peut simplifier l'écriture de ceux-ci en l'automatisant par un lisp.

(vl-load-com)
(defun c:Label_Side_Color ( / js htx AcDoc Space n obj ename pr pt deriv rtx nw_obj)
 (princ "\nSélectionnez des lignes/polylignes: ")
 (setq js
(ssget
 	(list
   	'(0 . "LWPOLYLINE,LINE")
   	(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
   	(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
 	)
)
 )
 (cond
(js
 	(initget 6)
 	(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
 	(if htx (setvar "TEXTSIZE" htx))
 	(setq
   	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   	Space
   	(if (= 1 (getvar "CVPORT"))
     	(vla-get-PaperSpace AcDoc)
     	(vla-get-ModelSpace AcDoc)
   	)
 	)
 	(cond
   	((null (tblsearch "LAYER" "Label Color"))
     	(vla-add (vla-get-layers AcDoc) "Label Color")
   	)
 	)
 	(repeat (setq n (sslength js))
   	(setq
     	obj (ssname js (setq n (1- n)))
     	ename (vlax-ename->vla-object obj)
     	pr (* 0.5 (vlax-curve-getEndParam ename))
     	pt (vlax-curve-GetpointAtParam ename pr)
     	deriv (vlax-curve-getFirstDeriv ename pr)
     	rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
   	)
   	(if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
   	(setq nw_obj
     	(vla-addMtext Space
       	(vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
       	0.0
       	(strcat
         	"{\\fArial|b0|i0|c0|p34;"
         	"%<\\AcObjProp Object(%<\\_ObjId "
         	(itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
         	">%).TrueColor>%"
       	)
     	)
   	)
   	(mapcar
     	'(lambda (pr val)
       	(vlax-put nw_obj pr val)
     	)
     	(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill)
     	(list 5 (getvar "TEXTSIZE") 5 pt "Standard" "Label Color" rtx 0)
   	)
 	)
)
 )
 (prin1)
)

 

  • Upvote 1

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Bonsoir,

 

Merci le code réponds à mes attentes

 

Cordialement

 

Comme le dit Didier, les champs sont bien indiqués pour cela.Si tu en as beaucoup à faire on peut simplifier l'écriture de ceux-ci en l'automatisant par un lisp.

(vl-load-com)
(defun c:Label_Side_Color ( / js htx AcDoc Space n obj ename pr pt deriv rtx nw_obj)
 (princ "\nSélectionnez des lignes/polylignes: ")
 (setq js
(ssget
 	(list
   	'(0 . "LWPOLYLINE,LINE")
   	(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
   	(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
 	)
)
 )
 (cond
(js
 	(initget 6)
 	(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
 	(if htx (setvar "TEXTSIZE" htx))
 	(setq
   	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   	Space
   	(if (= 1 (getvar "CVPORT"))
     	(vla-get-PaperSpace AcDoc)
     	(vla-get-ModelSpace AcDoc)
   	)
 	)
 	(cond
   	((null (tblsearch "LAYER" "Label Color"))
     	(vla-add (vla-get-layers AcDoc) "Label Color")
   	)
 	)
 	(repeat (setq n (sslength js))
   	(setq
     	obj (ssname js (setq n (1- n)))
     	ename (vlax-ename->vla-object obj)
     	pr (* 0.5 (vlax-curve-getEndParam ename))
     	pt (vlax-curve-GetpointAtParam ename pr)
     	deriv (vlax-curve-getFirstDeriv ename pr)
     	rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
   	)
   	(if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
   	(setq nw_obj
     	(vla-addMtext Space
       	(vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
       	0.0
       	(strcat
         	"{\\fArial|b0|i0|c0|p34;"
         	"%<\\AcObjProp Object(%<\\_ObjId "
         	(itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
         	">%).TrueColor>%"
       	)
     	)
   	)
   	(mapcar
     	'(lambda (pr val)
       	(vlax-put nw_obj pr val)
     	)
     	(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill)
     	(list 5 (getvar "TEXTSIZE") 5 pt "Standard" "Label Color" rtx 0)
   	)
 	)
)
 )
 (prin1)
)

 

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

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é