Aller au contenu
Problème de lien d'inscription (résolu ?) ×

[Résolu] Longueurs de segments dans un polygone

pierrevigneux

Par pierrevigneux
dans Routines LISP

 Partager

Messages recommandés

lili2006 Community Regular

lili2006

Posté(e)
Posté(e)

Bonjour à toutes et tous,

 

A propos de SEGLEN, je me demandais si il était "facile" de rajouter un préfixe et un suffixe,..

 

En topographie, une cote entre changement de direction s'exprime de cette façon :

 

 -23.12-

 

Ou de passer par un filtrage et de rajouter ce symbole en début et fin de texte, mais je n'ai pas trouvé d'astuces,...

 

Merci d'avance,

Civil 3D 2024 - COVADIS_18.2

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites
(gile) Proficient

(gile)

Posté(e)
Posté(e)
Bonjour à toutes et tous,

 

A propos de SEGLEN, je me demandais si il était "facile" de rajouter un préfixe et un suffixe,..

 

En topographie, une cote entre changement de direction s'exprime de cette façon :

 

 -23.12-

 

Ou de passer par un filtrage et de rajouter ce symbole en début et fin de texte, mais je n'ai pas trouvé d'astuces,...

 

Merci d'avance,

 

Voilà :

 

EDIT : corrigé un oubli, voir plus bas.

 

EDIT : conservation de la hauteur de texte dans le dessin.

 

;;; 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	(/ *error* format temp file dcl_id slst	st jlst	ju ht pre suf ro fs stat ss space n obj
	 len pa	txt fs ent pt)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))

 ;; redéfintion locale de *error*
 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;; 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)
     )
   )
   (vla-put-StyleName txt st)
 )

 ;; 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;}"
     ":edit_box{"
     "label=\"Préfixe\";key=\"pre\";edit_width=16;allow_accept=true;}"
     ":edit_box{"
     "label=\"Suffixe\";key=\"suf\";edit_width=16;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
ju  "Bas Centre"		; justification (voir liste)
ht  (cond			; hauteur de texte
      ((vlax-ldata-get "SegLen" "TextHeight"))
      ((getvar "TEXTSIZE"))
    )
pre ""				; préfixe
suf ""				; suffixe
ro  "al"			; rotation ("al" ou "ho")
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 "pre" pre)
 (set_tile "suf" suf)
 (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))
    (< 0 (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 "pre" "(setq pre $value)")
 (action_tile "suf" "(setq suf $value)")
 (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 '((410 . "Model")
		(-4 . "<OR")
		(0 . "LINE")
		(-4 . "<AND")
		(0 . "*POLYLINE")
		(-4 . "<NOT")
		(-4 . "&")
		(70 . 112)
		(-4 . "NOT>")
		(-4 . "AND>")
		(-4 . "OR>")
	       )
       )
     )
   )
    (progn
      (vla-StartUndoMark *acdoc*)
      (vlax-ldata-put "SegLen" "TextHeight" ht)
      (setq space (vlax-get *acdoc*
		     (if (= (getvar 'cvport) 1)
		       'PaperSpace
		       'ModelSpace
		     )
	   )
      )

      ;; 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
	 space
	 (strcat pre (rtos len) suf)
	 (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
	 space
	 (strcat pre (rtos len) suf)
	 (vlax-3d-point pt)
	 ht
       )
     )
   )
 )
      )
      (vla-Delete ss)
    )
 )
 (*error* nil)
)

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites
(gile) Proficient

(gile)

Posté(e)
Posté(e)
Bjr à tous,

 

Il semble que la case de dialogue du style de texte soit inopérante ...

Le style de texte courant prend le "dessus" sur un autre choix éventuel.

Quelqu'un peut confirmer cela ?

 

Oupss !!!

C'est carrément un oubli, je corrige le code ci dessus.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites
  • 2 mois après...
  • 9 mois après...
seb97320 Newbie

seb97320

Posté(e)
Posté(e)

Salut à tous,

 

Je cherchais sur le forum une routine tout à fait de ce style....mais chez moi elle ne fonctionne pas !!!

je lance la commande, la boite de dialogue s'affiche, je clique ok et là la commande se termine....elle ne me demande pas de sélectionné ma polyligne ???

 

si qq un a une idée ???

 

merci

Lien vers le commentaire
Partager sur d’autres sites
jalna Newbie

jalna

Posté(e)
Posté(e)

Salut

J'ai un message d'erreur :

; erreur: structure incorrecte de la chaîne en entrée

"Je suis fasciné par l'air. Si on enlevait l'air du ciel, tous les oiseaux tomberaient par terre... Et les avions aussi... En même temps l'air tu peux pas le toucher... Ca existe et ça existe pas... Ca nourrit l'homme sans qu'il ait faim... It's magic ! L'air c'est beau en même temps tu peux pas le voir, c'est doux et tu peux pas le toucher... L'air, c'est un peu comme mon cerveau..."

J-C Van Damme

Lien vers le commentaire
Partager sur d’autres sites
jalna Newbie

jalna

Posté(e)
Posté(e)

Super et merci!

"Je suis fasciné par l'air. Si on enlevait l'air du ciel, tous les oiseaux tomberaient par terre... Et les avions aussi... En même temps l'air tu peux pas le toucher... Ca existe et ça existe pas... Ca nourrit l'homme sans qu'il ait faim... It's magic ! L'air c'est beau en même temps tu peux pas le voir, c'est doux et tu peux pas le toucher... L'air, c'est un peu comme mon cerveau..."

J-C Van Damme

Lien vers le commentaire
Partager sur d’autres sites
(gile) Proficient

(gile)

Posté(e)
Posté(e)

Salut,

 

En l'état la routine affiche le nombre de décimales défini dans la variable système LUPREC, tu peux donc modifier la valeur de cette variable.

Sinon, tu peux modifier le code en remplaçant (c'est presque à la fin de la routine) :

(strcat pre (rtos len) suf)

par :

(strcat pre (rtos len 2 3) suf)

où le dernier chiffre dans l'expression (rtos ...), ici 3, est le nombre de décimales.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites
  • 2 ans après...
willy95 Explorer

willy95

Posté(e)
Posté(e)

Bonjour à tous,

 

Après avoir chercher sans trouver je reste toujours bloqué sur un petit probleme qui à été réaliser dans le lisp de Gile "Seglen", je m'explique : je cherche a faire apparaitre une boite de dialogue (sans fichier dcl) avec une seule question et 2 (voir plus si possible) réponses, mais une seule réponse qui peu etre cochée et entrer ma réponse dans une variable.

 

Quelquechose comme ça...

 

":boxed_column{label=\"Quel Choix voulez-vous ?\";"
":radio_row{key=\"ro\";"   
":radio_button{label=\"Choix A\";key=\"A\";}" 
":radio_button{label=\"Choix B\";key=\"B\";}}" 
"ok_cancel;}"

 

 

Mais je reste un plutot perdu, si une Ame charitable pouvait me comprendre et m'aider ?

Merci

Lien vers le commentaire
Partager sur d’autres sites
  • 2 semaines après...
joris25 Newbie

joris25

Posté(e)
Posté(e)

Je viens de découvrir cette sublime routine bravo !!!!!

 

Mais dans le genre casse pied (voir casse c...) y aurait il la possibilité que les textes soient legerement decalés du segment a peu pres decalé de la moitie de la hauteur du texte cela ferait plus joli...

 

d'avance merci pour cette routine qui va me valoir surement des compliment au bureau :P

 

salut à tous......

Lien vers le commentaire
Partager sur d’autres sites
  • 8 ans après...
barbichette Contributor

barbichette

Posté(e)
Posté(e)
Le 27/01/2011 à 10:25, (gile) a dit :

 

Voilà :

 

EDIT : corrigé un oubli, voir plus bas.

 

EDIT : conservation de la hauteur de texte dans le dessin.

 

  

;;; 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	(/ *error* format temp file dcl_id slst	st jlst	ju ht pre suf ro fs stat ss space n obj
	 len pa	txt fs ent pt)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))

 ;; redéfintion locale de *error*
 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;; 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)
     )
   )
   (vla-put-StyleName txt st)
 )

 ;; 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;}"
     ":edit_box{"
     "label=\"Préfixe\";key=\"pre\";edit_width=16;allow_accept=true;}"
     ":edit_box{"
     "label=\"Suffixe\";key=\"suf\";edit_width=16;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
ju  "Bas Centre"		; justification (voir liste)
ht  (cond			; hauteur de texte
      ((vlax-ldata-get "SegLen" "TextHeight"))
      ((getvar "TEXTSIZE"))
    )
pre ""				; préfixe
suf ""				; suffixe
ro  "al"			; rotation ("al" ou "ho")
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 "pre" pre)
 (set_tile "suf" suf)
 (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))
    (< 0 (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 "pre" "(setq pre $value)")
 (action_tile "suf" "(setq suf $value)")
 (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 '((410 . "Model")
		(-4 . "<OR")
		(0 . "LINE")
		(-4 . "<AND")
		(0 . "*POLYLINE")
		(-4 . "<NOT")
		(-4 . "&")
		(70 . 112)
		(-4 . "NOT>")
		(-4 . "AND>")
		(-4 . "OR>")
	       )
       )
     )
   )
    (progn
      (vla-StartUndoMark *acdoc*)
      (vlax-ldata-put "SegLen" "TextHeight" ht)
      (setq space (vlax-get *acdoc*
		     (if (= (getvar 'cvport) 1)
		       'PaperSpace
		       'ModelSpace
		     )
	   )
      )

      ;; 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
	 space
	 (strcat pre (rtos len) suf)
	 (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
	 space
	 (strcat pre (rtos len) suf)
	 (vlax-3d-point pt)
	 ht
       )
     )
   )
 )
      )
      (vla-Delete ss)
    )
 )
 (*error* nil)
)
 

 

 

Cette routine est tout simplement extraordinaire.

Comment pourrais-je la modifier pour que les longueurs se notent avec un décalage de 15cm par rapport à la ligne ?
La plupart des polylignes que je cherche à dimensionner sont des représentations de murs d'une épaisseur de 20 cm, et donc le texte est superposé avec la ligne)

 

Meric

 

 

 

***********************

Rien ne sert de courrir, il faut partir à point.

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
 Partager
Aller sur la liste des sujets
×
×
  • 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é