Polygone avec un nom pour chaque coté ...

[plastickman]

Bonjour,

 

Je ne sais pas si c'est réalisable, mais ça me ferait gagner beaucoup de temps.

J' aimerais pouvoir dessiner des polygones en faisant apparaitre à l'intérieur un nom pour chaque coté directement en traçant la figure. Par exemple un carré A, B, C, D où les lettres apparaitraient au milieu des cotés et à l'intérieur de la figure.

 

Merci d'avance.

 

jp

[bonuscad]

Bonjour,

 

Sur ton autre post lié au même sujet tu cite

je ne sais pas du tout utiliser le VBA sur Autocad

 

Par conséquent (n'étant pas un adepte du VBA), je te propose une solution en lisp.

 

(vl-load-com)
(defun c:Label_Side ( / js htx AcDoc Space nw_style obj ename pr t_char pt deriv rtx  nw_obj)
(princ "\nSélectionnez une polyligne.")
(while
	(null
		(setq js
			(ssget "_+.:E:S"
				(list
					'(0 . "LWPOLYLINE")
					(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
					(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
				)
			)
		)
	)
	(princ "\nCe n'est pas un objet valable pour cette fonction!")
)
(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"))
		(vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
	)
)
(cond
	((null (tblsearch "STYLE" "Romand-Label"))
		(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
		(mapcar
			'(lambda (pr val)
				(vlax-put nw_style pr val)
			)
			(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
			(list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
		)
	)
)
 (setq
   obj (ssname js 0)
   ename (vlax-ename->vla-object obj)
   pr -0.5
   t_char 64
 )
 (repeat (fix (vlax-curve-getEndParam ename))
   (setq
     pt (vlax-curve-GetpointAtParam ename (setq pr (1+ 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
       (chr (setq t_char (1+ t_char)))
     )
   )
   (mapcar
     '(lambda (pr val)
       (vlax-put nw_obj pr val)
     )
     (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
     (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx)
   )
 )
(prin1)
)

 

NB: Si tu ne sais pas utiliser le lisp, pour tester tu fais un copier--coller du code en ligne de commande

Après tu tapes "LABEL_SIDE" et tu sélectionnes un polygone.

[plastickman]

Merci beaucoup, mais je ne dois pas bien me débrouiller.

Je fais d'abord un copier/coller du code que tu m'as donné dans ma ligne de commande en bas d'Autocad. En suite je tape "LABEL_SIDE", Après, je sélectionne un polygone ou une polyligne dessinée, mais il ne se passe rien.

Mais, je ne suis pas bien sure de m'être bien exprimé...

Ce dont j'ai besoin en fait, c'est de dessiner des polylignes, et que , une fois bouclée, il apparaisse une lettre a L' INTÉRIEUR de ma figure devant chaque coté, toujours en suivant l'alphabet et en commençant par A.

Le plus simple serait peut-être que je t'envoie un exemple de choses que j'ai déjà dessiné.

 

[bonuscad]

Après, je sélectionne un polygone ou une polyligne dessinée, mais il ne se passe rien.

 

Voici ce que tu devrais avoir en ligne de commande

 

Commande: LABEL_SIDE

 

Sélectionnez une polyligne.

Choix des objets:ici tu sélectionnes ta polyligne

 

Spécifiez la hauteur du texte <2.5000>: ici tu donnes, soit au clavier, soit graphiquement (curseur élastique au centre de la vue) la hauteur de ton texte désiré

 

Commande

 

Et maintenant les textes devraient apparaitre (code fait sous 2009)

[lili2006]

Bonsoir à toutes et tous,

 

Marche parfaitement !

 

Testé sous civil 3D 2009

[LUDWIG]

Ca doit peut être être possible avec des blocs dynamiques de triangle, quadrilatère, pentagone, etc. si tu es sur 2006 ou plus.

[plastickman]

Bonsoir,

Désolé de ne pas avoir donné suite à ta proposition, bonuscad, mais comme je n'y connais pas grand chose en lisp, je ne savais pas qu'il fallait créer un fichier puis ensuite le charger, mais maintenant que j'ai pu le tester je confirme que ça marche très bien. Par contre, il y a juste une chose que j'aimerai modifier, et je n'ai pas trouver quel paramètre il fallait changer pour y arriver. J'aimerai que les lettres qui s'inscrivent apparaissent à l'intérieur de la figure une fois la polyligne bouclée et non pas à l'extérieur. Si tu pouvais me donner un ultime coup de pouce... ce serait très sympa.

Merci d'avance,

 

jp

[bonuscad]

Bonsoir,

 

J'ai eu un petit dilemme à résoudre:

Ma routine fonctionnant aussi avec des polylignes ouverte, il m'était difficile de déterminer le sens de parcours pour déterminer de quel coté placer les textes.

 

J'aurais pu la limiter à des polylignes fermées, puis tester si les textes étaient à l'intérieur.

J'ai préféré laisser la possibilité de traité aussi les polylignes ouvertes et de poser une question supplémentaire pour les changer de côté. (Et puis solution plus simple pour moi pour modifier le code) ;)

 

J'ai aussi enlevé un rem en début de ligne ";" présent dans le 1er code.

Celui oblige le texte à rester dans le sens de lecture (rotation de celui compris entre 180° et 0°)

Si ça ne te convient pas et que tu préfère tourner la tête pour lire, tu remets la ligne en remarque.

 

(vl-load-com)
(defun c:Label_Side ( / js htx AcDoc Space nw_style obj ename t_mod key pr t_char js_text pt deriv rtx nw_obj n)
(princ "\nSélectionnez une polyligne.")
(while
	(null
		(setq js
			(ssget "_+.:E:S"
				(list
					'(0 . "LWPOLYLINE")
					(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
					(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
				)
			)
		)
	)
	(princ "\nCe n'est pas un objet valable pour cette fonction!")
)
(initget 6)
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte [b]<[/b]" (rtos (getvar "TEXTSIZE")) "[b]>[/b]: ")))
(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"))
		(vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
	)
)
(cond
	((null (tblsearch "STYLE" "Romand-Label"))
		(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
		(mapcar
			'(lambda (pr val)
				(vlax-put nw_style pr val)
			)
			(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
			(list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
		)
	)
)
 (setq
   obj (ssname js 0)
   ename (vlax-ename-[b]>[/b]vla-object obj)
   t_mod '+
   key "Yes"
 )
 (repeat 2
   (setq pr -0.5 t_char 64 js_text (ssadd))
   (if (eq key "Yes")
   (repeat (fix (vlax-curve-getEndParam ename))
     (setq
       pt (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
       deriv (vlax-curve-getFirstDeriv ename pr)
       rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
     )
     (setq nw_obj
       (vla-addMtext Space
         (vlax-3d-point (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
         0.0
         (chr (setq t_char (1+ t_char)))
       )
     )
     (if (or ([b]>[/b] rtx (* pi 0.5)) ([b]<[/b] rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_obj pr val)
       )
       (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
       (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx)
     )
     (ssadd (entlast) js_text)
   )
   )
   (if (not (eq t_mod '-))
     (progn
       (initget "Oui Non _Yes No")
       (if (eq (setq key (getkword "\nPasser les labels de l'autre côté [Oui/Non]? [b]<[/b]Non[b]>[/b]: ")) "Yes")
         (progn (setq n -1 t_mod '-) (repeat (sslength js_text) (entdel (ssname js_text (setq n (1+ n))))))
         (setq t_mod '-)
       )
     )
   )
 )
(prin1)
)

[plastickman]

Bonsoir,

Je ne sais pas comment te remercier, c'est exactement ce dont j'avais besoin !!!

Tu ne t'imagines même pas le temps que tu vas me faire gagner !!!

Encore merci,

 

jp