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

[Olivier Eckmann]

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