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

Poly 3d vers poly 2D pour création solide

Didj05

Par Didj05
dans Covadis

 Partager

Messages recommandés

Olivier Eckmann Proficient

Olivier Eckmann

Posté(e)
Posté(e)

Bonjour @Didj05,

 

Voilà un code qui devrait faire l'affaire en récupérant à droite et à gauche des codes dont je me suis inspiré 

; inspiré du code de DIDIER disponible : https://www.da-code.fr/polyligne-3d/
(defun lsVtxPoly3D (oPoly / n oPolyDxf lsPts)
  (if (= (cdr (assoc 0 (setq oPolyDxf (entget oPoly)))) "POLYLINE")
    (progn
      (setq oPoly (entnext oPoly))      
      (while (/= (cdr (assoc 0 (setq oPolyDxf (entget oPoly)))) "SEQEND")
	  (setq lsPts (append lsPts (list (cdr (assoc 10 oPolyDxf)))))	  
	  (setq oPoly (entnext oPoly))
      ); fin du WHILE
    );progn
    (alert "le choix n'est pas une POLY 3D")
  );if poly3d
  lsPts
); fin de DEFUN

; inspiré du code de LeeMac : https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun MakeLWPoly (lst cls dElev vDir / p)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 cls)
			  (cons 38 dElev)
		    )
                    (mapcar (function (lambda (p) (cons 10 p))) lst)
		    (list (cons 210 vDir))
	    )
  )
)

; Transforme un point 3D en point à Z=0
(defun Point2D (PT)
  (list (car PT) (cadr PT) 0.)
)  

; reconstruit des polylignes 2D dans un plan vertical à partir de polyligne 3D supposée être dans ce plan vertical
(defun C:ProfilP3DtoP2D ( / ssP3D sLayerP3D vAUNITS vANGBASE vANGDIR I oP3D lsPts dAng
			    PT PT1 PT2 PT2D PT1_2D PT2_2D dDist dDistMax vDir lsPts2D)
  (setq sLayerP3D "Ptrav_ENROCHEMENTS SECS_3D")
  (if (setq ssP3D (ssget (list (cons 0 "POLYLINE") (cons 8 sLayerP3D) (cons -4 "&") (cons 70 8))))
    (progn
      (setq vAUNITS  (getvar "AUNITS"))
      (setq vANGBASE (getvar "ANGBASE"))
      (setq vANGDIR  (getvar "ANGDIR"))
      (setvar "AUNITS"  3)
      (setvar "ANGDIR"  0.)
      (setvar "ANGBASE" 0.)
      
      (setq I 0)
      (repeat (sslength ssP3D)
	(setq oP3D (ssname ssP3D I))
	(setq I (1+ I))
	(setq lsPts (lsVtxPoly3D oP3D))
	; recherche les 2 points les plus éloignés en 2D
	(setq PT1 (car lsPts))
	(setq PT1_2D (Point2D PT1))
	(setq iVtx 0)
	(setq dDistMax 0.)
	(while (< (setq iVtx (1+ iVtx)) (length lsPts))
	  (setq PT (nth iVtx lsPts))
	  (setq PT2D (Point2D PT))
	  (if (> (setq dDist (distance PT1_2D PT2D)) dDistMax)
	    (setq PT2_2D PT2D
		  dDistMax dDist)
	  )
	  
	)
	; calcule l'angle entre ces 2 points
	(setq dAng (angle PT1_2D PT2_2D))
	; construit le SCU orienté, puis vertical
	(command "_UCS" "_W")
	(command "_UCS" "_Z" dAng)
	(command "_UCS" "_X" (* PI 0.5))
	(setq vDir (getvar "UCSXDIR"))
	(setq vDir (list (cadr vDir) (* -1. (car vDir)) 0.))

	; convertit le liste des sommets 3D en sommet 2D dans le SCU vertical
	(setq lsPts2D nil)
	(foreach PT lsPts
	  (setq lsPts2D (append lsPts2D (list (Point2D (trans PT 0 1)))))
	)

	; Contruit la poly2D vertical
	(MakeLWPoly lsPts2D (logand (cdr (assoc 70 (entget oP3D))) 1) (caddr (trans (car lsPts) 0 1)) vDir)
      )
      
      (setvar "ANGDIR"  vANGDIR)
      (setvar "ANGBASE" vANGBASE)
      (setvar "AUNITS"  vAUNITS)
      (command "_UCS" "_W")
    )
  )
)

Ce code présuppose un certain nombre d'hypothèse :

- les polylignes 3D sont définies dans un plan vertical

- les polylignes 3D ont une longueur 2D projetée non nulle

- dessine les poly2D dans le calque courant.

 

A tester, car aucun contrôle dans ce code, tout est supposé être bien dessiné. Ce n'est pas forcément très rapide, puisque ça passe par les commandes de création de SCU pour chaque polyligne, mais ça traduit la méthode manuelle de construction/dessin.

 

Olivier

ProfilP3DtoP2D.lsp

  • 2 semaines après...
Didj05 Apprentice

Didj05

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

Je rentre juste de congé et reprend le fil.

Le 20/09/2024 à 22:56, Olivier Eckmann a dit :

Bonjour @Didj05,

 

Voilà un code qui devrait faire l'affaire en récupérant à droite et à gauche des codes dont je me suis inspiré 

; inspiré du code de DIDIER disponible : https://www.da-code.fr/polyligne-3d/
(defun lsVtxPoly3D (oPoly / n oPolyDxf lsPts)
  (if (= (cdr (assoc 0 (setq oPolyDxf (entget oPoly)))) "POLYLINE")
    (progn
      (setq oPoly (entnext oPoly))      
      (while (/= (cdr (assoc 0 (setq oPolyDxf (entget oPoly)))) "SEQEND")
	  (setq lsPts (append lsPts (list (cdr (assoc 10 oPolyDxf)))))	  
	  (setq oPoly (entnext oPoly))
      ); fin du WHILE
    );progn
    (alert "le choix n'est pas une POLY 3D")
  );if poly3d
  lsPts
); fin de DEFUN

; inspiré du code de LeeMac : https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun MakeLWPoly (lst cls dElev vDir / p)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 cls)
			  (cons 38 dElev)
		    )
                    (mapcar (function (lambda (p) (cons 10 p))) lst)
		    (list (cons 210 vDir))
	    )
  )
)

; Transforme un point 3D en point à Z=0
(defun Point2D (PT)
  (list (car PT) (cadr PT) 0.)
)  

; reconstruit des polylignes 2D dans un plan vertical à partir de polyligne 3D supposée être dans ce plan vertical
(defun C:ProfilP3DtoP2D ( / ssP3D sLayerP3D vAUNITS vANGBASE vANGDIR I oP3D lsPts dAng
			    PT PT1 PT2 PT2D PT1_2D PT2_2D dDist dDistMax vDir lsPts2D)
  (setq sLayerP3D "Ptrav_ENROCHEMENTS SECS_3D")
  (if (setq ssP3D (ssget (list (cons 0 "POLYLINE") (cons 8 sLayerP3D) (cons -4 "&") (cons 70 8))))
    (progn
      (setq vAUNITS  (getvar "AUNITS"))
      (setq vANGBASE (getvar "ANGBASE"))
      (setq vANGDIR  (getvar "ANGDIR"))
      (setvar "AUNITS"  3)
      (setvar "ANGDIR"  0.)
      (setvar "ANGBASE" 0.)
      
      (setq I 0)
      (repeat (sslength ssP3D)
	(setq oP3D (ssname ssP3D I))
	(setq I (1+ I))
	(setq lsPts (lsVtxPoly3D oP3D))
	; recherche les 2 points les plus éloignés en 2D
	(setq PT1 (car lsPts))
	(setq PT1_2D (Point2D PT1))
	(setq iVtx 0)
	(setq dDistMax 0.)
	(while (< (setq iVtx (1+ iVtx)) (length lsPts))
	  (setq PT (nth iVtx lsPts))
	  (setq PT2D (Point2D PT))
	  (if (> (setq dDist (distance PT1_2D PT2D)) dDistMax)
	    (setq PT2_2D PT2D
		  dDistMax dDist)
	  )
	  
	)
	; calcule l'angle entre ces 2 points
	(setq dAng (angle PT1_2D PT2_2D))
	; construit le SCU orienté, puis vertical
	(command "_UCS" "_W")
	(command "_UCS" "_Z" dAng)
	(command "_UCS" "_X" (* PI 0.5))
	(setq vDir (getvar "UCSXDIR"))
	(setq vDir (list (cadr vDir) (* -1. (car vDir)) 0.))

	; convertit le liste des sommets 3D en sommet 2D dans le SCU vertical
	(setq lsPts2D nil)
	(foreach PT lsPts
	  (setq lsPts2D (append lsPts2D (list (Point2D (trans PT 0 1)))))
	)

	; Contruit la poly2D vertical
	(MakeLWPoly lsPts2D (logand (cdr (assoc 70 (entget oP3D))) 1) (caddr (trans (car lsPts) 0 1)) vDir)
      )
      
      (setvar "ANGDIR"  vANGDIR)
      (setvar "ANGBASE" vANGBASE)
      (setvar "AUNITS"  vAUNITS)
      (command "_UCS" "_W")
    )
  )
)

Ce code présuppose un certain nombre d'hypothèse :

- les polylignes 3D sont définies dans un plan vertical

- les polylignes 3D ont une longueur 2D projetée non nulle

- dessine les poly2D dans le calque courant.

 

A tester, car aucun contrôle dans ce code, tout est supposé être bien dessiné. Ce n'est pas forcément très rapide, puisque ça passe par les commandes de création de SCU pour chaque polyligne, mais ça traduit la méthode manuelle de construction/dessin.

 

Olivier

ProfilP3DtoP2D.lsp 3.04 Ko · 0 téléchargement

Je rentre juste de congés et reprend le fil..... Merci, merci et merci beaucoup pour ce lisp qui marche à merveille et va me faire gagner beaucoup de temps ! Je suis super content ! Encore merci Olivier !!!
Problème résolu !

Didj05 Apprentice

Didj05

Posté(e)
  • Auteur
Posté(e)
Le 20/09/2024 à 22:56, Olivier Eckmann a dit :

Bonjour @Didj05,

 

Voilà un code qui devrait faire l'affaire en récupérant à droite et à gauche des codes dont je me suis inspiré 

; inspiré du code de DIDIER disponible : https://www.da-code.fr/polyligne-3d/
(defun lsVtxPoly3D (oPoly / n oPolyDxf lsPts)
  (if (= (cdr (assoc 0 (setq oPolyDxf (entget oPoly)))) "POLYLINE")
    (progn
      (setq oPoly (entnext oPoly))      
      (while (/= (cdr (assoc 0 (setq oPolyDxf (entget oPoly)))) "SEQEND")
	  (setq lsPts (append lsPts (list (cdr (assoc 10 oPolyDxf)))))	  
	  (setq oPoly (entnext oPoly))
      ); fin du WHILE
    );progn
    (alert "le choix n'est pas une POLY 3D")
  );if poly3d
  lsPts
); fin de DEFUN

; inspiré du code de LeeMac : https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun MakeLWPoly (lst cls dElev vDir / p)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 cls)
			  (cons 38 dElev)
		    )
                    (mapcar (function (lambda (p) (cons 10 p))) lst)
		    (list (cons 210 vDir))
	    )
  )
)

; Transforme un point 3D en point à Z=0
(defun Point2D (PT)
  (list (car PT) (cadr PT) 0.)
)  

; reconstruit des polylignes 2D dans un plan vertical à partir de polyligne 3D supposée être dans ce plan vertical
(defun C:ProfilP3DtoP2D ( / ssP3D sLayerP3D vAUNITS vANGBASE vANGDIR I oP3D lsPts dAng
			    PT PT1 PT2 PT2D PT1_2D PT2_2D dDist dDistMax vDir lsPts2D)
  (setq sLayerP3D "Ptrav_ENROCHEMENTS SECS_3D")
  (if (setq ssP3D (ssget (list (cons 0 "POLYLINE") (cons 8 sLayerP3D) (cons -4 "&") (cons 70 8))))
    (progn
      (setq vAUNITS  (getvar "AUNITS"))
      (setq vANGBASE (getvar "ANGBASE"))
      (setq vANGDIR  (getvar "ANGDIR"))
      (setvar "AUNITS"  3)
      (setvar "ANGDIR"  0.)
      (setvar "ANGBASE" 0.)
      
      (setq I 0)
      (repeat (sslength ssP3D)
	(setq oP3D (ssname ssP3D I))
	(setq I (1+ I))
	(setq lsPts (lsVtxPoly3D oP3D))
	; recherche les 2 points les plus éloignés en 2D
	(setq PT1 (car lsPts))
	(setq PT1_2D (Point2D PT1))
	(setq iVtx 0)
	(setq dDistMax 0.)
	(while (< (setq iVtx (1+ iVtx)) (length lsPts))
	  (setq PT (nth iVtx lsPts))
	  (setq PT2D (Point2D PT))
	  (if (> (setq dDist (distance PT1_2D PT2D)) dDistMax)
	    (setq PT2_2D PT2D
		  dDistMax dDist)
	  )
	  
	)
	; calcule l'angle entre ces 2 points
	(setq dAng (angle PT1_2D PT2_2D))
	; construit le SCU orienté, puis vertical
	(command "_UCS" "_W")
	(command "_UCS" "_Z" dAng)
	(command "_UCS" "_X" (* PI 0.5))
	(setq vDir (getvar "UCSXDIR"))
	(setq vDir (list (cadr vDir) (* -1. (car vDir)) 0.))

	; convertit le liste des sommets 3D en sommet 2D dans le SCU vertical
	(setq lsPts2D nil)
	(foreach PT lsPts
	  (setq lsPts2D (append lsPts2D (list (Point2D (trans PT 0 1)))))
	)

	; Contruit la poly2D vertical
	(MakeLWPoly lsPts2D (logand (cdr (assoc 70 (entget oP3D))) 1) (caddr (trans (car lsPts) 0 1)) vDir)
      )
      
      (setvar "ANGDIR"  vANGDIR)
      (setvar "ANGBASE" vANGBASE)
      (setvar "AUNITS"  vAUNITS)
      (command "_UCS" "_W")
    )
  )
)

Ce code présuppose un certain nombre d'hypothèse :

- les polylignes 3D sont définies dans un plan vertical

- les polylignes 3D ont une longueur 2D projetée non nulle

- dessine les poly2D dans le calque courant.

 

A tester, car aucun contrôle dans ce code, tout est supposé être bien dessiné. Ce n'est pas forcément très rapide, puisque ça passe par les commandes de création de SCU pour chaque polyligne, mais ça traduit la méthode manuelle de construction/dessin.

 

Olivier

ProfilP3DtoP2D.lsp 3.04 Ko · 1 téléchargement

Une dernière question car je suis une quiche en lisp, est-il possible de ne pas limiter la transformation 3d vers 2d juste au calque Ptrav_ENROCHEMENTS SECS_3D  mais à l'ensemble des polylignes 3d sélectionnées ? Enfin c'est un détail... 😉 

Merci

Capture d’écran 2024-10-02 141543.jpg

Didj05 Apprentice

Didj05

Posté(e)
  • Auteur
Posté(e)
il y a 11 minutes, Olivier Eckmann a dit :

Remplace 

(setq sLayerP3D "Ptrav_ENROCHEMENTS SECS_3D")

par  

(setq sLayerP3D "*")

 

Vous êtes vraiment au top. Merci beaucoup !!!

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é