Cotation de Polyligne

[willy95]

Comment faire en lisp pour ecrire un simple texte justifier au milieu centre en arial qui recupere toutes les distance d'une polyligne automatiquement et qui les ecrits directement au centre de la ligne et cela pour chaque segment de polyligne ?

 

 

12.23

--------------------------------------------

 

Quelqu'un peut il m'aider ?

 

Merci

[lili2006]

Bonjour à toutes et tous,

 

Un début de piste => "CurveLength_Field " de bonuscad

 

(vl-load-com)
(defun c:CurveLength_Field ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw dxf_cod n ename m-param deriv nw_obj lremov)
(princ "\nSélectionnez un objet curviligne.")
(while
	(null
		(setq js
			(ssget "_+.:E:S"
				(list
					'(0 . "*POLYLINE,LINE,ARC,CIRCLE")
					(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
					(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
					'(-4 . "							'(-4 . "&")
						'(70 . 112)
					'(-4 . "NOT>")
				)
			)
		)
	)
	(princ "\nCe n'est pas un objet curviligne valable pour cette fonction!")
)
(initget 6)
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ : ")))
(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" "Id-Longueurs"))
		(vlax-put (vla-add (vla-get-layers AcDoc) "Id-Longueurs") 'color 96)
	)
)
(cond
	((null (tblsearch "STYLE" " [surligneur] Romand-Field[/surligneur]"))
		(setq nw_style (vla-add (vla-get-textstyles AcDoc) " [surligneur] Romand-Field[/surligneur]"))
		(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)
		)
	)
)
(if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
	(progn
		(initget "KM ME CM MM")
		(if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] : ")))
			(setq unit_key "ME")
		)
		(cond
			((eq unit_key "KM")
				(setq unit_draw 1000000)
			)
			((eq unit_key "ME")
				(setq unit_draw 1000 unit_key "M")
			)
			((eq unit_key "CM")
				(setq unit_draw 10)
			)
			((eq unit_key "MM")
				(setq unit_draw 1)
			)
		)
		(setvar "USERS5" (strcat "qz" (itoa unit_draw)))
	)
	(progn
		(setq unit_draw (atoi (substr (getvar "USERS5") 3)))
		(cond
			((eq unit_draw 1000000)
				(setq unit_key "KM")
			)
			((eq unit_draw 1000)
				(setq unit_key "M")
			)
			((eq unit_draw 10)
				(setq unit_key "CM")
			)
			((eq unit_draw 1)
				(setq unit_key "MM")
			)
		)
	)
)
(initget "Unique Multiple _Single Multiple")
(if (eq (getkword "\nSélection filtrée [unique/Multiple]: ") "Single")
   (setq n -1)
   (setq
     dxf_cod (entget (ssname js 0))
     js
     (ssget "_X" 
       (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
         (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
       )
     )
     n -1
   )
 )
(repeat (sslength js)
   (setq
     obj (ssname js (setq n (1+ n)))
     ename (vlax-ename->vla-object obj)
     pt
     (vlax-curve-getPointAtDist
       ename 
       (* (vlax-get ename
         (cond
           ((eq (vla-get-ObjectName ename) "AcDbArc") 'ArcLength)
           ((eq (vla-get-ObjectName ename) "AcDbCircle") 'Circumference)
           (T 'Length)
         )
       ) 0.5)
     )
     deriv (vlax-curve-getFirstDeriv ename (vlax-curve-getParamAtPoint ename pt))
     rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
   )
   (if (or (> rtx (* pi 0.5)) (	(setq nw_obj
	(vla-addMtext Space
		(vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
		0.0
		(strcat
			"%				(itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
			">%)."
			(cond
				((eq (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbArc")
					"ArcLength"
				)
				((eq (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbCircle")
					"Circumference"
				)
				(T
					"Length"
				)
			)
			" \\f \"%lu2%pr2%ps[L=,"
			(strcase unit_key T)
			"]\">%"
		)
	)
)
(mapcar
	'(lambda (pr val)
		(vlax-put nw_obj pr val)
	)
	(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
	(list 5 (getvar "TEXTSIZE") 5 pt " [surligneur] Romand-Field[/surligneur]" "Id-Longueurs" rtx)
)
)
(prin1)
) 

 

Tu peux modifier le texte "" [surligneur] Romand-Field"[/surligneur] par [surligneur] Arial [/surligneur]si tu le souhaites,...

[lecrabe]

 

Hello

 

C la routine SEGLEN qu'il te faut : :)

 

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=16871#pid67906

 

A priori elle correspondond parfaitement a ta demande :D

Je l'utilise de temps en temps ... Encore Merci à Gilles :cool:

 

Le Decapode

 

[lili2006]

Re,

 

Ah bah j'connaissais pas !

 

Il manque plus que les champs,... ;)

[willy95]

Merci pour toute cette réactivité...

 

La routine de Gile "Seglen" me donne la bonne piste, mais je n'arrive pas a comprendre ou il insere le texte pour que je puisse orienter chaque texte dans la direction des lignes.

 

De plus j'ai beaucoup de mal à inserer des fleches sur chaque sommet automatiquement , sans selectionner chaqu'un d'entre eux un par un.

 

 

[(gile)]

Salut,

 

J'ai modifié SegLen, les textes seront créés dans le style de texte courant.

 

(defun c:seglen	(/ ss ht n ent len pa txt)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (if (and
(setq ss (ssget	'((-4 . "[b]			  (0 . "LINE")
		  (-4 . "[b]			  (0 . "*POLYLINE")
		  (-4 . "[b]			  (-4 . "&")
		  (70 . 112)
		  (-4 . "NOT>")
		  (-4 . "AND>")
		  (-4 . "OR>")
		 )
	 )
)
(	   (setq ht (getdist "\nSpécifiez la hauteur de texte: "))
)
     )
   (progn
     (vla-StartUndoMark acdoc)
     (repeat (setq n (sslength ss))
(setq ent (ssname ss (setq n (1- n))))
(if (= "LINE" (cdr (assoc 0 (entget ent))))
  (progn
    (setq len (vlax-curve-getDistAtParam
		ent
		(vlax-curve-getEndParam ent)
	      )
    )
    (vla-addText
      (vla-get-ModelSpace acdoc)
      (rtos len)
      (vlax-3d-point
	(vlax-curve-getPointAtDist ent (/ len 2.0))
      )
      ht
    )
  )
  (repeat (setq pa (fix (vlax-curve-getEndParam ent)))
    (setq
      len (- (vlax-curve-getDistAtParam ent pa)
	     (vlax-curve-getDistAtParam ent (setq pa (1- pa)))
	  )
    )
    (setq txt
	   (vla-addText
	     (vla-get-ModelSpace acdoc)
	     (rtos len)
	     (vlax-3d-point '(0 0 0))
	     ht
	   )
    )
    (vla-put-Alignment txt acAlignmentMiddleCenter)
    (vla-put-TextAlignmentPoint
      txt
      (vlax-3d-point
	(vlax-curve-getPointAtparam ent (+ pa 0.5))
      )
    )
    (vla-put-Rotation
      txt
      (angle (vlax-curve-getPointAtParam ent pa)
	     (vlax-curve-getPointAtParam ent (1+ pa))
      )
    )
  )
)
     )
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
) 

 

PS : lili2006, met plutôt des liens, en copiant le code, le formatage a altéré le filtre de sélection.

[lili2006]

Re,

 

Salut (gile),

 

000en copiant le code, le formatage a altéré le filtre de sélection.

 

C'est à dire ?

[lecrabe]

 

Hello Gilles / lili2006

 

Je viens de tester la nouvelle version de SEGLEN sur MAP 2004 & sur MAP 2009

 

c OK comme d'hab, merci Gilles ! :)

 

SVP je suggère une petite amélioration :

Décalage éventuel (Defaut 0.00) = xx.xx

Ainsi le texte sera éventuellement au dessus du segment de la polyligne ...

 

Pour les polylignes qui tournent dans le mauvais sens,

j'utilise ton R_PLINE depuis longtemps ! :P

 

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=10953#pid

 

Bientot la routine R_PLINE ne sera plus du tout utile ... ;)

 

Le Decapode (grippé)

 

 

[lecrabe]

 

ReHello

 

Tant qu'à faire une petite modif, il faut aussi poser une autre question :

 

Texte Horizontal ou suivant l'Orientation du segment (Defaut = H) H/O :

 

Le Decapode (qui a toujours des suggestions)

 

[willy95]

Encore une fois MERCI Gile pour ton aide

 

J'ai beaucoup de difficultées a tout conprendre avec les "vla" , je me bat pour conprendre...

 

Doucement mais surement....

 

 

Je me bat aussi pour inserer la surface et le périmètre total de la polyligne selectionnée dans un fichier txt, dans le pline2txt que Gile à ecrit.

[bonuscad]

C'est à dire ?

 

lili2006 les signes "> " sont mal interprétés et font disparaitre du code.

 

Je n'avais pas proposé cette solution car dans la demande il était dit de vouloir coter les SEGMENTS.

Ce que ne fait pas "CurveLength_Field.lsp"

 

Les champs de s'appliquent pas entre les sommets mais sur la totalité de la polyligne.

 

Voir le code original ici en bas de page.

 

J'ai essayé de réfléchir à une solution pour modifier ce code, ce serait de dupliquer en entité simple (Arc, ligne) et de mettre l'attribut invisible et de leur appliquer les champs dynamique.

L'inconvénient du code d'invisibilté, c'est que celle ci ne réagiraient plus aux champ dynamique car la sélection lors de modification ne pourrait s'appliquer de façon classique.

 

Donc bof!...

[willy95]

Superbe idée que le décalage de la cotation, mais je ne sais pas du tout comment faire..

[lili2006]

Re,

 

Ok, merci bonuscad !

 

Si j'ai besoin de coter des segments, j'explose la polyligne mais c'est vrai que ce n'est pas tip-top, mais mieux que rien !

 

Quand j'ai besoin de garder les polylignes, je les copies sur un calque,...

 

Double travail, certes mais résultat tout de même ok !

 

Bon dimanche @ tous,

[(gile)]

Voilà une nouvelle version plus élaborée.

L'utilisateur choisi le style de texte, la justification, la hauteur et l'orientation dans une petite boite de dialogue.

 

Version (un peu) commentée

 

;;; SEGLEN (gile)
;;; Crée un texte sur chaque segment de ligne ou polyligne sélectionné
;;; dont la valeur est la longueur du segment.

(defun c:seglen	(/ acdoc temp	file dcl_id slst st jlst ju ht ro fs stat ss n obj len
	 pa txt fs ent pt)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; sous routine de formatage du texte : justification et rotation
 (defun format	(txt / ang)
   (vla-put-Alignment
     txt
     (cond
((= ju "Gauche") acAlignmentLeft)
((= ju "Centre") acAlignmentCenter)
((= ju "Droite") acAlignmentRight)
((= ju "Milieu") acAlignmentMiddle)
((= ju "Haut Gauche") acAlignmentTopLeft)
((= ju "Haut Centre") acAlignmentTopCenter)
((= ju "Haut Droite") acAlignmentTopRight)
((= ju "Milieu Gauche") acAlignmentMiddleLeft)
((= ju "Milieu Centre") acAlignmentMiddleCenter)
((= ju "Milieu Droite") acAlignmentMiddleRight)
((= ju "Bas Gauche") acAlignmentBottomLeft)
((= ju "Bas Centre") acAlignmentBottomCenter)
((= ju "Bas Droite") acAlignmentBottomRight)
     )
   )
   (or	(= ju "Gauche")
(vla-put-TextAlignmentPoint txt (vlax-3d-point pt))
   )
   (and
     (= ro "al")
     (setq ang	(angle '(0. 0. 0.)
	       (vlax-curve-getfirstDeriv
		 obj
		 (vlax-curve-getParamAtPoint obj pt)
	       )
	)
     )
     (if (and (= fs "1") (minusp (cos ang)))
(vla-put-Rotation txt (+ pi ang))
(vla-put-Rotation txt ang)
     )
   )
 )

 ;; création de la boite de dialogue (écriture dans un fichier temporaire)
 (setq	temp (vl-filename-mktemp "Tmp.dcl")
file (open temp "w")
 )
 (write-line
   (strcat
     "IncTxt:dialog{"
     "label=\"Longueurs de segments\";"
     ":boxed_column{"
     "label=\"Mise en forme\";"
     ":popup_list{"
     "label=\"Style\";key=\"st\";edit_width=16;}"
     ":popup_list{"
     "label=\"Justification\";key=\"ju\";edit_width=16;}"
     ":edit_box{"
     "label=\"Hauteur\";key=\"ht\";edit_width=5;allow_accept=true;}"
     ":boxed_column{label=\"Orientation\";"
     ":radio_row{key=\"ro\";"
     ":radio_button{label=\"Horizontal\";key=\"ho\";}"
     ":radio_button{label=\"Aligné\";key=\"al\";}}"
     ":toggle{label=\"Forcer le sens de lecture\";key=\"fs\";}}}"
     "ok_cancel;}"
    )
   file
 )
 (close file)

 ;; initialisation et chargement de la boite de dialogue
 (setq dcl_id (load_dialog temp))
 (if (not (new_dialog "IncTxt" dcl_id))
   (exit)
 )
 (while (setq st (tblnext "STYLE" (not st)))
   (if	(/= (cdr (assoc 2 st)) "")
     (setq slst (cons (cdr (assoc 2 st)) slst))
   )
 )

 ;; liste déroulante "Style"
 (setq slst (reverse slst))
 (start_list "st")
 (mapcar 'add_list slst)
 (end_list)

 ;; liste déroulante "Justification"
 (setq	jlst '("Gauche"		 "Centre"	   "Droite"
       "Milieu"		 "Haut Gauche"	   "Haut Centre"
       "Haut Droite"	 "Milieu Gauche"   "Milieu Centre"
       "Milieu Droite"	 "Bas Gauche"	   "Bas Centre"
       "Bas Droite"
      )
 )
 (start_list "ju")
 (mapcar 'add_list jlst)
 (end_list)

 ;; initialisation des variables
 (setq st (getvar "TEXTSTYLE")) ; style de texte
 (setq ju "Bas Centre") ; justification (voir liste)
 (setq ht (getvar "TEXTSIZE")) ; hauteur de texte
 (setq ro "al") ; rotation ("al" ou "ho")
 (setq fs "1") ; sens écriture ("1" ou "0")

 ;; affichage des éléments en fonction des variables
 (set_tile "st" (itoa (vl-position st slst)))
 (set_tile "ju" (itoa (vl-position ju jlst)))
 (set_tile "ht" (rtos ht))
 (set_tile "ro" ro)
 (set_tile "fs" fs)

 ;; définitions des actions des éléments
 (action_tile "st" "(setq st (nth (atoi $value) slst))")
 (action_tile "ju" "(setq ju (nth (atoi $value) jlst))")
 (action_tile
   "ht"
   "(if (and (numberp (distof $value))
    (     (setq ht (distof $value))
    (progn
    (alert \"Nécessite un nombre réel strictement positif\")
    (set_tile \"ht\" (rtos ht))
    (mode_tile \"ht\" 2))))"
 )
 (action_tile "ho" "(setq ro $key) (mode_tile \"fs\" 1)")
 (action_tile "al" "(setq ro $key) (mode_tile \"fs\" 0)")
 (action_tile "fs" "(setq fs $value)")
 (action_tile "accept" "(done_dialog 1)")
 (action_tile "cancel" "(done_dialog 0)")
 (setq stat (start_dialog))

 ;; déchargemet de la boite de dialogue et suppression du fichier DCL
 (unload_dialog dcl_id)
 (vl-file-delete temp)

 ;; Sélection des polylignes et lignes
 (if (and (= stat 1)
   (setq ss (ssget '((-4 . "			     (0 . "LINE")
		     (-4 . "			     (0 . "*POLYLINE")
		     (-4 . "			     (-4 . "&")
		     (70 . 112)
		     (-4 . "NOT>")
		     (-4 . "AND>")
		     (-4 . "OR>")
		    )
	    )
   )
     )
   (progn
     (vla-StartUndoMark acdoc)

     ;; traitement du jeu de sélection
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet acdoc))
(if (= (vla-get-ObjectName obj) "AcDbLine")
  ;; lignes
  (progn
    (setq len (vlax-curve-getDistAtParam
		obj
		(vlax-curve-getEndParam obj)
	      )
	  pt  (vlax-curve-getPointAtDist obj (/ len 2.0))
    )
    (format
      (vla-addText
	(vla-get-ModelSpace acdoc)
	(rtos len)
	(vlax-3d-point pt)
	ht
      )
    )
  )
  ;; polylignes
  (repeat (setq pa (fix (vlax-curve-getEndParam obj)))
    (setq
      len (- (vlax-curve-getDistAtParam obj pa)
	     (vlax-curve-getDistAtParam obj (setq pa (1- pa)))
	  )
      pt  (vlax-curve-getPointAtparam obj (+ pa 0.5))
    )
    (format
      (vla-addText
	(vla-get-ModelSpace acdoc)
	(rtos len)
	(vlax-3d-point pt)
	ht
      )
    )
  )
)
     )
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
)  

[lecrabe]

 

Hello Gilles

 

Cette nouvelle version de SEGLEN est super mais je pense qu'il faut ajouter l'option de décalage éventuel ... Comme tu le sens ! :)

 

Le Decapode

 

[(gile)]

J'ai un peu la flemme et je trouve qu'avec une justification Bas Centre et l'option Aligné, c'est pas mal...

[lecrabe]

 

Hello

 

Ah oui, tu as raison : je n'avais pas pensé à Bas-Centre, j'étais obnubilé par Milieu-Centre

 

C bien comme ça, Merci, Le Decapode

 

PS1: J'adore tes DCLs à la volée !

 

PS2: Tu as trouvé cette ruse où ? The swamp peut être !?

 

[(gile)]

Tu as trouvé cette ruse où ? The swamp peut être !?

 

Oui, TheSwamp est vraiment une mine, avec des programmeurs du monde entier.

Tous les langages de programmations y sont abordé, c'est juste un peu difficile pour moi, parce qu'on en parle en anglais...

[lili2006]

Re,

 

Vraiment terrible ! :P

 

J'adore tes DCLs à la volée !

 

Moi aussi !,

[(gile)]

Je le fais avant qu'on me le demande :cool:

 

J'ai ajouté une case à cocher "Forcer le sens de lecture" accessible uniquement en mode aligné.

Si cette case est décochée, les textes sont alignés à la polyligne et suivent son sens (donc certains peuvent se retrouver "à l'envers".

En cochant cette case, on force le sens des textes dans le sens de lecture.

[lili2006]

Re,

 

Je le fais avant qu'on me le demande

 

Il est vrai que je fais parti de ceux qui aiment bien les BD,... ;)

 

Je pense qu'en utilisation "poussée" de AutoCAD (disons 35h00 / semaine minimum) je changerai ma méthode,..

 

Mais je ne me sers pas assez d'AutoCAD en temps normal pour me rappeler de tous les noms de commande Lisp !

 

Pour les fonctions natives AutoCAD, je pense avoir assez "optimiser" les raccourcis clavier,...

 

Merci encore, :P

[lili2006]

Re,

 

Test rapide (même très rapide,... ;) ) =>

 

Commande: _appload seglen.LSP correctement chargé(s)

seglen.LSP correctement chargé(s)

Commande: ; erreur: cdrs supplémentaire dans la paire pointée en entrée

Commande: ; erreur: cdrs supplémentaire dans la paire pointée en entrée

Commande:

Commande: seglen

Commande inconnue "SEGLEN". Appuyez sur F1 pour obtenir de l'aide.

[(gile)]

Je ne parlais pas de devancer une demande de boite de dialogue (je pense qu'à partir d'un certain nombre d'options, c'est plus pratique), mais la demande concernant l'orientation des textes dans le sens de lecture.

 

J'avais encore oublié un "

[lili2006]

Re,

 

Oups !

 

Comme quoi, ne jamais interpréter ce que pense les autres,....

 

Et je passe ma vie à répéter ça à mon entourage, j'ai l'air malin maintenant ! :mad:

 

Mais bon, rien de grave à partir du moment ou la communication existe,... :P

 

En ce qui concerne "SEGLEN ", tout fonctionne Nickel !

 

Tip-top cette nouvelle routine,...

 

Merci encore (gile),

 

Bonne soirée,

 

 

[willy95]

Vous etes vraiement génial et vous m'impressionner ENORMEMENT, de plus par rapport au peu de language que je commence tous juste a comprendre et mettre en pratique, la je suis vraiement perdu et le résultat en est encore plus spectaculaire.

 

Alors tant qu'a faire peut on avoir le choix du Calque ?

 

Pour ma part j'essai ce type de ligne, mais sans succes :

 

(IF (= (TblSearch "Layer" "Cotes") nil))

(command "_Layer" "_N" "Cotes" "_CO" "2" "Cotes" ""))

(command "_Layer" "_S" "Cotes" "")

 

 

Ps: je suis sur qu'un menu deroulant pour le calque comme le choix de style serait mieux.