conversion polyligne 3d en polyligne 2d

[nellou]

Bonjour,

J'ai des client qui me demande la transformation de mon fichier 3d en 2D. Leur but est d'avoir un fichier polyligne 3D et un fichier polyligne 2D pour pouvoir avoir la symbologie de leur trait (car en polyligne 3d le type de ligne est obligatoirement en continu d'un point de vu visuel). Je ne peux pas définir le type de ligne dans la couche car pour une même couche j'ai plusieurs type de trait différent.

Pour mettre à zéro mes polylignes je n'ai pas de problème car mon logiciel de levé terrain (land2map) à un fonction automatique pour le faire. Mon problème est la transformation de la polyligne 3d en 2d

 

Je dispose d'autocad map 3d 2017.

 

J'ai déjà fait pas mal de recherche est :

- commande Modificationgroupe de fonctions ConceptionConvertir des polylignes 3D en 2D  (Convert3dPolys) ne fonctionne que sous AutoCAD Civil 3D 2018

- commande mettre à zero (flatten) --> décomposer (decompos) --> joindre les lignes créer : cette commande marche mais n'est pas viable car j'ai beaucoup de segment et beaucoup de couche dans mon fichier (trop chronophage)

- sur le forum j'ai trouver ce sujet mais le message 5 n'est plus disponible (j'ai fait une demande au niveau des administrateurs) et le message 6 ne marche pas (erreur: nombre d'arguments insuffisants)

J'ai vraiment besoin d'aide car là je ne trouve plus rien sachant que je suis encore débutante sous autocad et que je suis la seule dans mon entreprise à l'utiliser.

 

Merci par avance

 

[Eric]

Bonjour, 

Ca peut se faire avec la commande FLATTEN en répondant "yes" à la demande :

Remove hidden lines? <Yes>: y

[nellou]

après essai

flatten --> yes : j'ai la ligne qui disparait

flatten --> non : la ligne ne fait que se mettre à zero et reste polyligne 3d

😌

 

[SF.Designer]

Il me semble que "LWconvert.lsp" de Maitre Gilles fait ce que tu demande !!!

 

LWConvert.lsp

[nellou]

Merci pour la lsp mais pas de résultat il convertit les polylignes 2d en polylignes optimisées. Du coup on a

Commande: LWCONVERT
Sélectionnez les polylignes 2d <toutes>

 

et donc ça marche pas.

Après c'est peut-être moi qui comprends mal la commande

 

[Curlygoth]

je sais que ce n'est pas dans du VBA car du es dans le lisp mais bon si ça peut aider...

j'ai enlevé ce qui ne te concerne pas (il reste peut être des variables inutilisées m'enfin bon c'est pour dépanner hein 🙂

et si tu dois utilisé mon code en brut je te conseil de faire une copie du fichier 😉

Citation

Dim retcoord()
Dim PT() As Double
Dim P1(0 To 2) As Double
Dim Bloc As AcadBlockReference
Dim ObjPo As AcadLWPolyline
Dim polyObj As Acad3DPolyline
Dim color As AcadAcCmColor

Dim sVer As String
sVer = Left(AcadApplication.ActiveDocument.GetVariable("ACADVER"), 2)
Set Couleur = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor." & sVer)

X = 0
Y = 1
Z = 2
PREC = 3
NB_OBJ = ThisDrawing.ModelSpace.Count - 1

For o = 0 To ThisDrawing.ModelSpace.Count - 1
Set entity = ThisDrawing.ModelSpace.Item(o)
T = entity.ObjectName
Select Case entity.ObjectName
    Case "AcDb3dPolyline"
        Set polyObj = entity
        LIST_PT = polyObj.Coordinates
        CALQUE_OBJ = polyObj.Layer
        Epaisseur = polyObj.Lineweight
        L = LBound(LIST_PT)
        u = UBound(LIST_PT)
        NB_PT_3D = (u + 1) / 3
        cp = 0
        ReDim PT(NB_PT_3D * 2 - 1)
        For i = L To u Step 3
            Xo = LIST_PT(i)
            Yo = LIST_PT(i + 1)
            Zo = LIST_PT(i + 2)
                PT(cp) = Xo
                cp = cp + 1
                PT(cp) = Yo
                cp = cp + 1
        Next i
        NB_PT = (UBound(PT) + 1) / 2
                Set ObjPo = ThisDrawing.ModelSpace.AddLightWeightPolyline(PT)
                ObjPo.Layer = polyObj.Layer

          
                ObjPo.Lineweight = polyObj.Lineweight
                ObjPo.Update
                polyObj.Delete
                o = o - 1
    Case Else
    End Select
Next o

 

 

 

[Eric]

Ca serait possible d'avoir un fichier dwg avec ces fameuses polylignes 3D ?

[nellou]

Je débute dans autocad et je suis nouvelle sur le site. Du coup j'avais pas vu que j'étais sur une discutions avec thème particulier! kelboulet 😅

Merci pour ta réponse par contre là j’avoue je ne sais pas comment utiliser ton VBA (j'ai installer le module VBA mais après je ne sais pas comment faire pour utiliser ton programme)

[nellou]

voici un exemple avec à gauche les lignes en 3d et à droite leur équivalent visuel 2d que je voudrais obtenir

 

exemple poly 3d.dwg

[La Lozère]

Bonjour,

Je pense qu'en adaptant un peu les lisp de @(gile) ou de @bonuscad se trouvant sur ce post, il y a moyen de faire quelque chose. J'ai essayé, mais je n'ai pas trouvé.

 

 

[bonuscad]

Bonjour,

J'ai modifié le code d’aplatissement essentiellement d'objets curviligne. Celui ci tient maintenant compte aussi d'une éventuelle élévation de l'objet pour le ramener en Z à zéro.

Voir le code mis à jour ICI

[La Lozère]

Bon, après de moult essais, j'ai modifié (à ma façon 😁) le code de @(gile) cité ci-avant pour ajouter une option permettant de transformer les polylignes 3D en polylignes 2D avec une élévation à 0.

(defun c:toto (/ *error* doc opt del ss alt zlst pl)
 (vl-load-com)
 (defun *error* (msg)
   (and (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (and ss (vla-delete ss))
   (vla-EndUndoMark doc)
   (princ)
 )
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (if (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8)))
   (progn
     (vla-StartUndoMark doc)
     (initget "maXimum miNimum moYenne Zéro")
     (or (setq	opt
	 (getkword
	   "\Altitude de la polyligne plane [maXimum/miNimum/Zéro/moYenne] : "
	 )
  )
  (setq opt "moYenne")
     )
     (initget "Oui Non")
     (or (setq	del
	 (getkword "\nSupprimer la polyligne 3d source ? [Oui/Non] : ")
  )
  (setq del "Non")
     )
     (vlax-for	p (setq ss (vla-get-ActiveSelectionSet doc))
(setq pts (3d-coord->pt-lst (vlax-get p 'Coordinates))
      zlst (mapcar 'caddr pts)
      alt (cond         
	    ((= opt "maXimum")
	     (apply 'max zlst)
	    )
	    ((= opt "miNimum")
	     (apply 'min zlst)
	    )
 	    ((= opt "Zéro")
	     (apply '- '(1 1))
	    )             
	    (T (/ (apply '+ zlst) (length pts)))
	  )
      pl  (vlax-invoke
	    (vla-get-ModelSpace doc)
	    'addLightWeightPolyline
	    (apply
	      'append
	      (mapcar
		'(lambda (p)
		   (setq p (trans p 0 (trans '(0 0 1) 1 0 T)))
		   (list (car p) (cadr p))
		 )
		pts
	      )
	    )
	  )
)
(vla-put-elevation pl alt)
(vla-put-Closed pl (vla-get-Closed p))
(if (= del "Oui")
  (vla-delete p)
)
     )
     (vla-delete ss)
     (vla-EndUndoMark doc)
   )
 )
 (princ)
)

;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

 

[nellou]

Merci pour les modifs le programme marche il me change les poly 3d en 2d mais il y a un hic il me met en type de ligne celle "du calque". Sur un même calque j'ai plusieurs ligne avec des symbologies différentes

Il y a t'il un commande/ligne de progra qui existe pour lui dire de garder celle définie avant la transformation?

Désolé d'être aussi chiante.

En tous cas merci à tous pour vos réponses et votre temps

[Luna]

Coucou,

Essaye avec ceci :

(defun c:toto (/ *error* doc opt del ss alt zlst pl)
 (vl-load-com)
 (defun *error* (msg)
   (and (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (and ss (vla-delete ss))
   (vla-EndUndoMark doc)
   (princ)
 )
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (if (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8)))
   (progn
     (vla-StartUndoMark doc)
     (initget "maXimum miNimum moYenne Zéro")
     (or (setq	opt
	 (getkword
	   "\Altitude de la polyligne plane [maXimum/miNimum/Zéro/moYenne] <moYenne> : "
	 )
  )
  (setq opt "moYenne")
     )
     (initget "Oui Non")
     (or (setq	del
	 (getkword "\nSupprimer la polyligne 3d source ? [Oui/Non] <Non> : ")
  )
  (setq del "Non")
     )
     (vlax-for	p (setq ss (vla-get-ActiveSelectionSet doc))
(setq pts (3d-coord->pt-lst (vlax-get p 'Coordinates))
      zlst (mapcar 'caddr pts)
      alt (cond         
	    ((= opt "maXimum")
	     (apply 'max zlst)
	    )
	    ((= opt "miNimum")
	     (apply 'min zlst)
	    )
 	    ((= opt "Zéro")
	     (apply '- '(1 1))
	    )             
	    (T (/ (apply '+ zlst) (float (length pts))))
	  )
      pl  (vlax-invoke
	    (vla-get-ModelSpace doc)
	    'addLightWeightPolyline
	    (apply
	      'append
	      (mapcar
		'(lambda (p)
		   (setq p (trans p 0 (trans '(0 0 1) 1 0 T)))
		   (list (car p) (cadr p))
		 )
		pts
	      )
	    )
	  )
)
(vla-put-elevation pl alt)
(vla-put-Closed pl (vla-get-Closed p))
;;; Ajouter un point-virgule ; devant les lignes ci-dessous si l'on ne désire pas conserver la propriété de l'objet initial
(vla-put-EntityTransparency pl (vla-get-EntityTransparency p)) ; Conserve la propriété d'échelle de type de ligne de l'objet initial
(vla-put-Layer pl (vla-get-Layer p))                 ; Conserve la propriété de calque de l'objet initial
(vla-put-Linetype pl (vla-get-Linetype p))           ; Conserve la propriété de type de ligne de l'objet initial
(vla-put-LinetypeScale pl (vla-get-LinetypeScale p)) ; Conserve la propriété d'échelle de type de ligne de l'objet initial
(vla-put-LineWeight pl (vla-get-LineWeight p))       ; Conserve la propriété d'épaisseur de ligne de l'objet initial
(vla-put-Material pl (vla-get-Material p))           ; Conserve la propriété de matériau de l'objet initial
(vla-put-TrueColor pl (vla-get-TrueColor p))         ; Conserve la propriété de couleur de l'objet initial
;;; Ajouter un point-virgule ; devant les lignes ci-dessus si l'on ne désire pas conserver la propriété de l'objet initial
(if (= del "Oui")
  (vla-delete p)
)
     )
     (vla-delete ss)
     (vla-EndUndoMark doc)
   )
 )
 (princ)
)

;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

J'ai ajouté les lignes

;;; Ajouter un point-virgule ; devant les lignes ci-dessous si l'on ne désire pas conserver la propriété de l'objet initial
(vla-put-EntityTransparency pl (vla-get-EntityTransparency p)) ; Conserve la propriété d'échelle de type de ligne de l'objet initial
(vla-put-Layer pl (vla-get-Layer p))                 ; Conserve la propriété de calque de l'objet initial
(vla-put-Linetype pl (vla-get-Linetype p))           ; Conserve la propriété de type de ligne de l'objet initial
(vla-put-LinetypeScale pl (vla-get-LinetypeScale p)) ; Conserve la propriété d'échelle de type de ligne de l'objet initial
(vla-put-LineWeight pl (vla-get-LineWeight p))       ; Conserve la propriété d'épaisseur de ligne de l'objet initial
(vla-put-Material pl (vla-get-Material p))           ; Conserve la propriété de matériau de l'objet initial
(vla-put-TrueColor pl (vla-get-TrueColor p))         ; Conserve la propriété de couleur de l'objet initial
;;; Ajouter un point-virgule ; devant les lignes ci-dessus si l'on ne désire pas conserver la propriété de l'objet initial

dans le code donné ci-dessus par @La Lozère (et j'ai juste rajouté un (float) pour l'élévation moyenne pour faire une division décimale et non euclidienne ^^").
Comme je l'ai indiqué, j'ai mis toutes les propriétés qui semblent exportables entre les deux objets, et si jamais tu ne veux pas conserver certaines propriétés, il suffit de rajouter un point-virgule ; devant la ligne concernée 😉

Bisous,
Luna

[bonuscad]

il y a 41 minutes, nellou a dit :

Merci pour les modifs le programme marche il me change les poly 3d en 2d mais il y a un hic il me met en type de ligne celle "du calque". Sur un même calque j'ai plusieurs ligne avec des symbologies différentes

Il y a t'il un commande/ligne de progra qui existe pour lui dire de garder celle définie avant la transformation?

Désolé d'être aussi chiante.

En tous cas merci à tous pour vos réponses et votre temps

Si les remarques concerne mon code, en effet je peux inclure la conservation du type de ligne (ainsi que l'échelle du type de ligne, l'épaisseur, et la couleur vraie)

Voici en pièce jointe le code

my_project.lsp

[Eric]

Flatten fonctionne aussi, mais cette commande tient compte de l'unité du dessin.

Pour que cela fonctionne, il faut temporairement remettre INSUNITS à 4 (millimètre)

 

[nellou]

Bonjour à  tous.

Pardon pour ma réponses tardives.

Je vous remercie car avec vos réponses j'ai une lsp qui marche très bien. Je vais gagner beaucoup de temps.

Je vous souhaite une bonne continuation et merci

nellou