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

[Maxime85]

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

 

[lecrabe]

Hello

 

No comprendo !? ... SVP un peu plus d'explications "comprehensibles" ?

 

Bye, lecrabe

[Maxime85]

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

[didier]

Coucou

je pense qu'avec les champs tu as moyen de faire

 

[bonuscad]

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)
)

 

[Maxime85]

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)
)