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

Covadis Etiquette - Epaisseur polyligne

La Lozère

Par La Lozère
dans Covadis

 Partager

Messages recommandés

La Lozère Proficient

La Lozère

Posté(e)
Posté(e)

Bonjour,

Savez-vous si il est possible de créer une étiquette Covadis qui reprendrait l'épaisseur d'une polyligne 2D ? Et son sens ?

Le but étant de créer une étiquette qui me donne le Ø et le sens d'un CAF.

Merki....

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V18.0c
Pisser sous la douche ne suffira pas
tiphon Enthusiast

tiphon

Posté(e)
Posté(e)

Bonjour
Une solution non testée est possible en créant une table de donnée Map qui stocke la largeur des polylignes 2D.
Puis écrire une donnée Map dans les étiquettes Covadis.

Cela demande un peu de travail et de connaitre les fonctionnalités Map ...

Cordialement

 

Vincent P. Collaborator

Vincent P.

Posté(e)
Posté(e)

Salut,

J'ai un petit lisp qui créé un texte à base de champs pour me diamètre et la longueur de mes cana ...
Je te laisse y jeter un coup d'œil et le modifier pour que ça te plaise 🙂

  

(vl-load-com)
(defun c:Cana (/ id diam long mtx poly pt dir) 
  (if (= nil CanaOldMtx) 
    (setq CanaOldMtx "")
  )
  (setq id   (vla-get-ObjectID (vlax-ename->vla-object (car (setq poly (entsel "Selectionner le tronçon :")))))
        diam (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " 
                     (itoa id)
                     ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%"
             )
        long (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                     (itoa id)
                     ">%).Length \\f \"%lu2%pr2\">%"
             )
  )
  (if (= "" (setq mtx (getstring T (strcat "Matériaux <" CanaOldMtx ">:")))) 
    (setq mtx CanaOldMtx)
  )
  (initget 1 "< >")
  (setq dir (getkword "Direction d'écoulement [ < / > ]"))
  (command "-TEXTMULT" 
           (setq pt 
                  (getpoint))
           "J"
           "MC"
           "L"
           0
           (if (= dir "<") 
             (strcat "<--   Ø" diam " " mtx "   " long "ml")
             (strcat "Ø" diam " " mtx "   " long "ml   -->")
           )
           ""
  )
  (setq CanaOldMtx Mtx)
  (princ)
)

Amicalement

Vincent P.

Lispeur éternel débutant!
Autocad Map3D 2023
Covadis-Autopist 18.2

La Lozère Proficient

La Lozère

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

Merci Vincent,

Pas mal ton Lisp. Surtout, le texte créé reste interactif. Il mériterait d'être un peu amélioré car le texte inséré est horizontal avec un point cliqué.

Le top serait l'insertion de ce texte au milieu du tronçon saisi, avec un décalage de x+ demi épaisseur de polyligne et avec un choix de l'orientation (et donc la petite flêche) suivant l'orientation de la polyligne.

Mais bon, je ne maitrise suffisamment pas le Lisp pour modifier ton code dans ce sens.

Merci.

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V18.0c
Pisser sous la douche ne suffira pas
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)
Il y a 9 heures, La Lozère a dit :

Merci Vincent,

Pas mal ton Lisp. Surtout, le texte créé reste interactif. Il mériterait d'être un peu amélioré car le texte inséré est horizontal avec un point cliqué.

Le top serait l'insertion de ce texte au milieu du tronçon saisi, avec un décalage de x+ demi épaisseur de polyligne et avec un choix de l'orientation (et donc la petite flêche) suivant l'orientation de la polyligne.

Mais bon, je ne maitrise suffisamment pas le Lisp pour modifier ton code dans ce sens.

Merci.

Tu peux essayer avec ce code: Il permet de faire une annotation sur 1 ou plusieurs polyligne ayant certaines propriétés communes.

Le sens sera demandé pour chaque polylignes. 

(vl-load-com)
(defun c:Label_Cana ( / js obj AcDoc Space nw_style pt htx rtx dir 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")
            (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" "Label-Canalisation"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "Label-Canalisation") 'color 96)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "Texte-Canalisation"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Canalisation"))
      (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)
      )
    )
  )
  (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))
        )
      )
    )
  )
  (repeat (setq n (sslength js))
    (setq
      obj (ssname js (setq n (1- n)))
      ename (vlax-ename->vla-object obj)
      pt
      (vlax-curve-getPointAtDist
        ename 
        (* (vlax-get ename '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")))
      dir nil
    )
    (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
    (redraw obj 3)
    (while (not (member dir '(">" "<" ""))) (setq dir (getstring "\nDirection d'écoulement \"< >\"?\(>\): ")))
    (if (eq dir "") (setq dir ">"))
    (redraw obj 4)
    (setq nw_obj
      (vla-addMtext Space
        (vlax-3d-point pt)
        0.0
        (strcat
          "Ø="
          "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
          (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
          ">%)."
          "ConstantWidth"
          " \\f \"%lu2%pr0%ct8[1000]\">%"
          "\\P" dir "\\PL="
          "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
          (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
          ">%)."
          "Length"
          " \\f \"%lu2%pr2\">%"
          "ml"
        )
      )
    )
    (mapcar
      '(lambda (pr val)
        (vlax-put nw_obj pr val)
      )
      (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
      (list 5 (getvar "TEXTSIZE") 5 pt "Texte-Canalisation" "Label-Canalisation" rtx)
    )
  )
  (prin1)
)

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

La Lozère Proficient

La Lozère

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

Bonjour @bonuscad,

Merci pour ce bout de code. Il est intéressant, mais ne correspond pas tout à fait à ce que je recherche.

Ici, si la polyligne contient plusieurs tronçons, il met le texte au milieu de toute la longueur de la polyligne avec le texte au-dessus et au dessous et la flèche sur la polyligne.

C'est quoi comme code ? Je ne reconnais pas complétement le Lisp.

Vincent serait plus proche de ce que je recherche. Le "seul" truc qu'il manque, c'est le positionnement automatique du texte au milieu du segment saisi et au-dessous du segment.

sh71.png

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V18.0c
Pisser sous la douche ne suffira pas
Vincent P. Collaborator

Vincent P.

Posté(e)
Posté(e)

Pour le coup, j'ai pas la maitrise suffisantes pour le faire proprement, et quand je voie la complexité du code de LeeMac ... 

Je me pencherais sur la question Jeudi, j'aurais du temps à y consacrer, adapter pour que les deux marchent de concert en une seul commande.

Lispeur éternel débutant!
Autocad Map3D 2023
Covadis-Autopist 18.2

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Et de cette façon? 

(vl-load-com)
(defun c:Label_Cana ( / AcDoc Space nw_style js htx ent_sel ent pt_sel param deriv rtx dir nw_obj)
  (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-Canalisation"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "Label-Canalisation") 'color 96)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "Texte-Canalisation"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Canalisation"))
      (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)
      )
    )
  )
  (princ "\nSélectionnez une polyligne.")
  (while
    (setq js
      (ssget "_+.:E:S"
        '(
          (0 . "*POLYLINE")
          (-4 . "<NOT")
            (-4 . "&") (70 . 112)
          (-4 . "NOT>")
        )
      )
    )
    (if (not htx)
      (progn
        (initget 6)
        (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: ")))
        (if htx (setvar "TEXTSIZE" htx) (setq htx (getvar "TEXTSIZE")))
      )
    )
    (setq ent_sel (ssnamex js 0))
    (if (not (eq ent (cadar ent_sel)))
      (progn
        (setq dir nil)
        (while (not (member dir '(">" "<" ""))) (setq dir (getstring "\nDirection d'écoulement \"< >\"?\(>\): ")))
        (if (eq dir "") (setq dir ">"))
      )
    )
    (setq
      ent (cadar ent_sel)
      pt_sel (cadar (cdddar ent_sel))
      obj (vlax-ename->vla-object ent)
      pt_sel (vlax-curve-getClosestPointTo obj pt_sel)
      param (vlax-curve-getparamatpoint obj pt_sel)
      deriv (vlax-curve-getFirstDeriv obj param)
      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 (polar pt_sel (- rtx (* 0.5 pi)) (vlax-get obj 'ConstantWidth)))
        (getvar "TEXTSIZE")
        (strcat
          (if (eq dir ">") "Ø=" "<-- Ø=")
          "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
          (itoa (vla-get-ObjectID obj))
          ">%)."
          "ConstantWidth"
          " \\f \"%lu2%pr0%ct8[1000]\">%"
          " L="
          "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
          (itoa (vla-get-ObjectID obj))
          ">%)."
          "Length"
          " \\f \"%lu2%pr2\">%"
          "ml"
          (if (eq dir ">") " -->" "")
        )
      )
    )
    (mapcar
      '(lambda (pr val)
        (vlax-put nw_obj pr val)
      )
      (list 'AttachmentPoint 'DrawingDirection 'StyleName 'Layer 'Rotation 'Width 'BackgroundFill)
      (list 2 5 "Texte-Canalisation" "Label-Canalisation" rtx 0.0 -1)
    )
  )
  (prin1)
)

 

  • Upvote 1

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

La Lozère Proficient

La Lozère

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

Bonjour @bonuscad,

SVP 2 petites adaptations si je peux abuser....

1- Suivant le sens choisi, est-il possible d'écrire "Ø=xxx L=yyy  -->" ou "<-- Ø=xxx L=yyym". La flèche au début ou à la fin.

2- Avoir un masque d'arrière plan au texte de la couleur de l'arrière plan.

Merci.

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V18.0c
Pisser sous la douche ne suffira pas
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)
Le 14/11/2023 à 14:33, La Lozère a dit :

Bonjour @bonuscad,

SVP 2 petites adaptations si je peux abuser....

1- Suivant le sens choisi, est-il possible d'écrire "Ø=xxx L=yyy  -->" ou "<-- Ø=xxx L=yyym". La flèche au début ou à la fin.

2- Avoir un masque d'arrière plan au texte de la couleur de l'arrière plan.

Merci.

Bonjour @La Lozère,

Ces demandes mineures ont été prises en compte et mises à jour dans le code précédent.

Bonne journée !

  • Upvote 1

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

thierry.garré Rising Star

thierry.garré

Posté(e)
Posté(e)
Le 09/11/2023 à 11:14, La Lozère a dit :

Bonjour,

Savez-vous si il est possible de créer une étiquette Covadis qui reprendrait l'épaisseur d'une polyligne 2D ? Et son sens ?

Le but étant de créer une étiquette qui me donne le Ø et le sens d'un CAF.

Merki....

Bonjour,

pour être sur. Ton besoin porte sur l'épaisseur de la polyligne ou sa largeur ????

 

merci d'avance

Thierry Garré

 

Géorail-Covadis-Autopiste-Autocad-Autocad Map-Infraworks 360- Navisworks -Recap

La Lozère Proficient

La Lozère

Posté(e)
  • Auteur
Posté(e)
il y a 6 minutes, thierry.garré a dit :

Bonjour,

pour être sur. Ton besoin porte sur l'épaisseur de la polyligne ou sa largeur ????

 

merci d'avance

Bonjour Thierry,
J'ai eu l'impression de lire @didier 😂 MAIS tu as raison, je me suis trompé de terme 😳. Je parlais de la largeur 😉.

  • Like 1
www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V18.0c
Pisser sous la douche ne suffira pas

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é