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

[Résolu] Routine traçage lignes avec étiquette attribut longueur

RémiW

Par RémiW
dans Routines LISP

 Partager

Messages recommandés

RémiW Newbie

RémiW

Posté(e)
Posté(e)

Bonjour à toutes et à tous,

 

Je me permets de m'adresser à vous afin de me dépatouiller d'un contrainte récurrente au moment de dessiner des lignes pour lesquelles je dois aussi renseigner la longueur. Pour l'instant je cote chaque ligne.

 

Je détaille :

 

L'idée serait une fonction lisp permettant de tracer une ligne "normalement" dans le calque courant mais que celle-ci soit accompagnée d'une étiquette d'attribut intégrant sa longueur en mètres.

Dans ma tête, l'étiquette serait la valeur de la longueur en mètres arrondie à 0.00 (texte sur fond opaque), placée au milieu de la ligne concernée et décalée de cette ligne de 200 par exemple (dessin en mm).

 

J'ai eu beau chercher sur ce forum, je n'ai pas réussi à trouver ce type de routine.

 

Quelqu'un saurait-il comment s'y prendre ?

 

Merci dans tous les cas de m'avoir lu :)

 

(Ci-dessous un aperçu de l'idée)

 

http://hpics.li/d3acb8e

Lien vers le commentaire
Partager sur d’autres sites
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Bonjour,

 

Je l'avais certainement déjà publié sur CadXp, mais comme il a pu changer depuis je préfère le republier.

Voir si ça te convient, cela permet de mettre en place des champs dynamique concernant la longueur d'entité. Celle-ci peuvent être des lignes, polylignes, arc ou cercle.

Elle peut être appliquée de manière unique ou multiple: multiple fera la même chose pour toutes les entités ayant les mêmes propriétés que le modèle sélectionné au départ.

 

(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 . "<NOT")
             '(-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 <" (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" "Id-Longueurs"))
     (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Longueurs") 'color 96)
   )
 )
 (cond
   ((null (tblsearch "STYLE" "Text-Field"))
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Field"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 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] <ME>: ")))
       (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]<M>: ") "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
         (if (eq (vla-get-ObjectName ename) "AcDbLine")
           (* 0.5 (vlax-get ename 'Length))
           (vlax-curve-getParamAtPoint ename pt)
         )
       )
     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
       "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
       (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 "Text-Field" "Id-Longueurs" rtx)
 )
 )
 (prin1)
)

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
RémiW Newbie

RémiW

Posté(e)
  • Auteur
Posté(e)

Bonjour bonuscad et un grand merci pour ta réponse.

 

Je n'avais pas réussi à mettre la main sur cette fonction (peut être mal cherché...)

 

Tu as parfaitement cerné ce dont je parlais :)

 

 

J'ai cependant une petite question sur le filtrage des éléments lorsque l'option "Multiple" est choisie.

 

Me serait-il possible de réduire le filtrage à un seul critère qui serait un préfixe de nom de calque, par exemple :

 

_EXEMPLE_*

 

J'ai en effet besoin de cette étiquette pour des lignes n'ayant pas forcément la même couleur ou le même type de ligne mais ayant toutes le même préfixe de nom de calque.

 

D'autre part, les plans me servant de base de dessin sont en millimètres, j'aimerais par contre afficher une valeur en 0.00m, quel coefficient/critère dois-je changer pour adapter ce programme ?

 

 

Je suis désolé pour ces questions pouvant peut être paraître évidentes, je commence tout juste à utiliser/adapter les routines dans ce langage et à découvrir son potentiel :)

 

Merci infiniment encore une fois pour le temps que tu accordes à ma question !

Lien vers le commentaire
Partager sur d’autres sites
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Alors pour ton besoin propre cela donnerai ceci.

 

Le nom du calque de l'entité sélectionné te sera retourné comme modèle, exemple: Calque1 (avec des lignes existant sous Calque1 .... à Calque9)

Au message Entrez le(s) nom(s) du/des calque(s) à traiter? :, tu peux soit utiliser les jokers (* ou ?), par exemple : Calque* ou Calque1,Calque3,Calque5 (séparation de chaque calque par une virgule ,.

 

ATTENTION aux fautes de frappe pour les noms de calques, aucun contrôle de validité est effectué.

 

Le résultat subira un facteur multiplicatif de 0.001 (pour faire une conversion de mm en m)

 

(vl-load-com)
(defun c:RemiW ( / 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 . "<NOT")
             '(-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 <" (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" "Id-Longueurs"))
     (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Longueurs") 'color 96)
   )
 )
 (cond
   ((null (tblsearch "STYLE" "Text-Field"))
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Field"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 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] <ME>: ")))
       (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]<M>: ") "Single")
   (setq n -1)
   (progn
     (setq
       dxf_cod (entget (ssname js 0))
     )
     (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8))) (setq lremov (cons (car n) lremov))))
       (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
     )
     (princ (strcat "\nLe nom du calque est :" (cdr (assoc 8 dxf_cod))))
     (setq dxf_cod (subst (cons 8 (getstring "\nEntrez le(s) nom(s) du/des calque(s) à traiter? : " T)) (assoc 8 dxf_cod) dxf_cod))
     (setq
       js (ssget "_X" 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
         (if (eq (vla-get-ObjectName ename) "AcDbLine")
           (* 0.5 (vlax-get ename 'Length))
           (vlax-curve-getParamAtPoint ename pt)
         )
       )
     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
       "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
       (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)
       "]%ct8[0.001]\">%"
     )
   )
 )
 (mapcar
   '(lambda (pr val)
     (vlax-put nw_obj pr val)
   )
   (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
   (list 5 (getvar "TEXTSIZE") 5 pt "Text-Field" "Id-Longueurs" rtx)
 )
 )
 (prin1)
)

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
RémiW Newbie

RémiW

Posté(e)
  • Auteur
Posté(e)

Tu m'aides vraiment beaucoup c'est sympa :)

 

Merci pour ta patience et ta pédagogie.

 

Dans une optique de rapidité et étant donné que les formats sont toujours identiques dans mes présentations, comment peut-on faire pour que lors des différentes questions posées à l'utilisateur une réponse pré-remplie soit proposée afin que l'utilisateur n'ait qu'à presser ENTREE ou ESPACE afin de valider les paramètres ? (sauf cas exceptionnels très rares où une modification des paramètres sera nécessaire)

 

Le paramètre du choix de l'unité par exemple est d'ores et déjà bien réglé sur ME par défaut.

 

L'idée serait de définir les valeurs suivantes par défaut :

 

- Hauteur de texte à 300 par défaut, sans passer par une sélection par réticule à l'écran

- Le choix de l'unité est déjà sur "ME", pas de changement

- Idem pour "Multiple", pas de changement

- Nom de calque proposé par défaut "_METRES*"

 

J'ai essayé d'ajouter dans le code, à la fin de la question utilisateur, une valeur entre <>, à l'image de <ME> pour le choix de l'unité mais cela semble poser problème avec * à la fin de "_METRES*" :

 

(getstring "\nEntrez le(s) nom(s) du/des calque(s) à traiter? <_METRES*>: " T)

 

Pour la hauteur de texte avec une valeur par défaut de 300 sans sélection à l'écran je suis encore plus perdu malheureusement...

 

J'espère ne pas trop abuser de ta bonté et de ton temps bonuscad.

 

Merci beaucoup pour les réponses déjà apportées.

Lien vers le commentaire
Partager sur d’autres sites
RémiW Newbie

RémiW

Posté(e)
  • Auteur
Posté(e)

Hello lecrabe !

 

Merci pour ta suggestion ! J'ai effectivement pu changer la variable TEXTSIZE dans mon fichier gabarit et la routine me propose bien désormais 300 par défaut.

Ce qui m'intéresserait maintenant, pour la question de la hauteur de texte, serait de retirer la sélection par réticule à l'écran.

 

Vous êtes au top niveau réactivité ! :)

 

EDIT : Quelle serait la variable à modifier si je voulais décaler un peu plus le texte par rapport à la ligne (doubler l'écart par exemple) ?

Lien vers le commentaire
Partager sur d’autres sites
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Voici ce qu'il te faudra changer dans le code pour répondre à tes demandes.

 

Pour la hauteur du texte, au lieu de changer ton gabarit fait simplement ce rajout:

  (setvar "TEXTSIZE" 300.0)

devant les lignes

(initget 6)

(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: ")))

(if htx (setvar "TEXTSIZE" htx))

NB: (getdist) permet la saisie à l'écran, MAIS la saisie d'une valeur numérique au clavier est permise, autrement changer (getdist) par (getreal) qui ne permet que la saisie au clavier.

 

pour le nom du calque par défaut subtitut les lignes

(princ (strcat "\nLe nom du calque est :" (cdr (assoc 8 dxf_cod))))

(setq dxf_cod (subst (cons 8 (getstring "\nEntrez le(s) nom(s) du/des calque(s) à traiter? : " T)) (assoc 8 dxf_cod) dxf_cod))

par:

     (princ (strcat "\nLe nom du calque est :" (cdr (assoc 8 dxf_cod))))
     (setq nam_lay (getstring "\nEntrez le(s) nom(s) du/des calque(s) à traiter? <_METRES*>: " T))
     (if (eq nam_lay "") (setq  nam_lay "_METRES*"))
     (setq dxf_cod (subst (cons 8 nam_lay) (assoc 8 dxf_cod) dxf_cod))

mettre nam_lay en variable locale sera plus propre.

NB: (getstring "message" T) permet la saisie d'espace dans le nom du calque, donc obligation de validation de la valeur par défaut par la touche ENTREE. Si tu supprime le T, la validation par la barre espace sera possible mais tu ne pourra fournir d'espace dans le nom du calque, à toi de voir.

 

Quelle serait la variable à modifier si je voulais décaler un peu plus le texte par rapport à la ligne (doubler l'écart par exemple) ?

Intéresse toi à la ligne de la variable pt:

(vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))

tu pourrais faire par exemple:

(vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (* 2.0 (getvar "TEXTSIZE")))))

 

Entraine toi à faire ces modifs, bon courage.

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
RémiW Newbie

RémiW

Posté(e)
  • Auteur
Posté(e)

Au top bonuscad !

 

J'ai bien réussi à intégrer les différentes modifications que tu m'as proposées.

La routine tourne au poil !

Seule la modification getdist en getreal me retourne une erreur mais ce n'est pas grave, la présence du curseur n'est pas gênante en fin de compte.

 

Un grand merci pour toute cette aide, ce sujet est donc [RESOLU] !

 

Bonne journée :)

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é