Polyligne 2D vers 3d

[RhymOne]

Bonjour à tous mes amis autocadiens, voila je recherche activement un lisp pour transformer une polyligne 2d vers une polyligne 3D après de nombreux recherche j'ai laisser tomber, soit le code ne marchait pas ou c'eatit pour des lignes.

Voila Polyigne 2D Vers 3D.

Merci d'avance

[(gile)]

Salut,

 

Quelque chose comme ça ?

Fonctionne avec les polylignes 2d et les polylignes optimisées

Les propriétés de la polyligne source (calque couleur type de ligne..) sont conservées

Les éventuelles données étendues (xdata) sont copiées dans la nouvelle polyligne 3d

 

;; GetVertices
;; Retourne la liste des sommets des polylignes (coordonnées SCG)
;;
;; Argument : ename de la polyligne

(defun GetVertices (ent / elst pt plst)
 (setq elst (entget ent))
 (cond
   ((= (cdr (assoc 0 elst)) "LWPOLYLINE")
    (setq elv (cdr (assoc 38 elst)))
    (apply 'append
    (mapcar
      '(lambda (x)
	 (if (= 10 (car x))
	   (list (trans (list (cadr x) (caddr x) elv) ent 0))
	 )
       )
      elst
    )
    )
   )
   ((= (cdr (assoc 0 elst)) "POLYLINE")
    (setq pt (entnext ent))
    (while (= (cdr (assoc 0 (setq elst (entget pt)))) "VERTEX")
      (setq
 plst (cons (if	(zerop (logand 120 (cdr (assoc 70 elst))))
	      (trans (cdr (assoc 10 elst)) ent 0)
	      (cdr (assoc 10 elst))
	    )
	    plst
      )
 pt   (entnext pt)
      )
    )
    (reverse plst)
   )
 )
)

;; CONVERT3D
;; Convertit les polylignes 2d ou lw sélectionnées ent polylignes 3d

(defun c:convert3d (/ n fltr ss pl elst)
 (setq	n    0
fltr '((-4 . "	       (0 . "LWPOLYLINE")
       (-4 . "	       (0 . "POLYLINE")
       (-4 . "	       (-4 . "&")
       (70 . 120)
       (-4 . "NOT>")
       (-4 . "AND>")
       (-4 . "OR>")
      )
 )
 (princ "\nSelectionner les polylignes ou ")
 (if (or (setq ss (ssget fltr))
  (setq ss (ssget "_X" fltr))
     )
   (while (setq pl (ssname ss n))
     (setq elst (entget pl '("*"))

    n	 (1+ n)
     )
     (entmake
(append
  (list
    '(0 . "POLYLINE")
    (assoc 67 elst)
    (assoc 410 elst)
    (assoc 8 elst)
    (cond
      ((assoc 6 elst))
      ((cons 6 "ByLayer"))
    )
    (cond
      ((assoc 62 elst))
      ((cons 62 256))
    )
    (cons 70 (+ 8 (logand 129 (cdr (assoc 70 elst)))))
  )
  (assoc -3 elst)
)
     )
     (foreach p (GetVertices pl)
(entmake
  (list
    '(0 . "VERTEX")
    (cons 10 p)
    '(70 . 32)
  )
)
     )
     (entmake '((0 . "SEQEND")))
     (entdel pl)
   )
 )
 (princ)
)

[lecrabe]

 

Hello Gilles

 

Comme d'hab. cela marche bien ! :)

 

Encore merci pour les membres CADXP et GEOREZO,

 

Le Decapode

 

[RhymOne]

Genial tout marche bien pour le polygnes simples, si elles ont des arces comment on fait?

 

C'est un bon début...

 

 

Avec Patiente Tout Arrive

[RhymOne]

Toujours pas d'idée pour le polylignes constitués de droite et de arc de cercle???

 

Merci d'avance

[(gile)]

Salut,

 

Si, des idées j'en ai, mais il faut aussi du temps pour les mettre en pratique...

[(gile)]

Salut,

 

Voilà une version qui traite les arcs des polylignes :

- les arcs des polylignes optimisées, polylignes 2d simples ou lissées sont figurés par une succession de 12 segments droits.

- les polylignes 2d splinées sont converties en leurs équivalents 3d

 

Les propriétés et Xdatas sont copiées dans les nouvelles polylignes 3d

 

;; CONVERT3D
;; Convertit les polylignes 2d ou lw sélectionnées en polylignes 3d
;; Les propriétés (calque, couleur, Fermée, type de ligne, épaisseur de ligne) et données étendues
;; sont copiées dans la polyligne 3d.
;; Les arcs de polylignes (optimisées, 2d simples et 2d lissées) sont remplacés par 12 segments droits.
;; Les polylignes 2d splinées sont converties en polylignes 3d lissées de même ordre.

(defun c:convert3d (/ *error* fltr ss plst ind nlst start dist n pl3d  dType dValue)
 (vl-load-com)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (vla-endUndoMark *acdoc*)
   (princ)
 )

 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (setq	fltr '((-4 . "	       (0 . "LWPOLYLINE")
       (-4 . "	       (0 . "POLYLINE")
       (-4 . "	       (-4 . "&")
       (70 . 120)
       (-4 . "NOT>")
       (-4 . "AND>")
       (-4 . "OR>")
      )
 )
 (princ "\nSelectionner les polylignes ou ")
 (if (or (ssget fltr) (ssget "_X" fltr))
   (progn
     (vla-startUndoMark *acdoc*)
     (vlax-for	pl (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(if (and (= (vla-get-ObjectName pl) "AcDb2dPolyline")
	 (> (vla-get-Type pl) 1)
    )
  (progn
    (setq
      pl3d
       (vlax-invoke
	 (vla-get-Block (vla-get-ActiveLayout *acdoc*))
	 'add3dPoly
	 (apply
	   'append
	   (mapcar
	     '(lambda (x) (trans x (vlax-get pl 'Normal) 0))
	     (3d-coord->pt-lst (vlax-get pl 'Coordinates))
	   )
	 )
       )
    )
    (vla-put-Type pl3d (1- (vla-get-Type pl)))
  )
  (progn
    (setq plst (VerticesList pl)
	  nlst nil
	  ind  0
    )
    (if	(or (= (vla-get-ObjectName pl) "AcDbPolyline")
	    (and (= (vla-get-ObjectName pl) "AcDb2dPolyline")
		 (= (vla-get-Type pl) 0)
	    )
	)
      (while (cadr plst)
	(if (= (vla-getBulge pl ind) 0.0)
	  (setq nlst (cons (car plst) nlst))
	  (progn
	    (setq start	(vlax-curve-getDistAtParam pl ind)
		  dist	(/ (- (vlax-curve-getDistAtParam pl (1+ ind))
			      start
			   )
			   12.0
			)
		  n	0
	    )
	    (repeat 12
	      (setq nlst (cons (vlax-curve-getPointAtDist
				 pl
				 (+ start (* n dist))
			       )
			       nlst
			 )
		    n	 (1+ n)
	      )
	    )
	  )
	)
	(setq plst (cdr plst)
	      ind  (1+ ind)
	)
      )
      (while (cadr plst)
	(setq start (vlax-curve-getDistAtParam pl ind)
	      dist  (/ (- (vlax-curve-getDistAtParam pl (1+ ind))
			  start
		       )
		       12.0
		    )
	      n	    0
	)
	(repeat	12
	  (setq	nlst (cons (vlax-curve-getPointAtDist
			     pl
			     (+ start (* n dist))
			   )
			   nlst
		     )
		n    (1+ n)
	  )
	)
	(setq plst (cdr plst)
	      ind  (1+ ind)
	)
      )
    )
    (setq nlst (cons (car plst) nlst))
    (setq
      pl3d (vlax-invoke
	     (vla-get-Block (vla-get-ActiveLayout *acdoc*))
	     'add3dPoly
	     (apply 'append (reverse nlst))
	   )
    )
  )
)
  (foreach p '(Closed	    Color	 Layer
	       LineWeight   Linetype	 LineTypeScale
	       TrueColor
	      )
    (if	(and (vlax-property-available-p pl p)
	     (vlax-property-available-p pl3d p T)
	)
      (vlax-put-property pl3d p (vlax-get-property pl p))
    )
  )
  (vla-getXdata pl "" 'dType 'dValue)
  (and dType (vla-setXdata pl3d dType dValue))
  (vla-delete pl)
)
     (vla-delete ss)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)

;; VerticesList (gile)
;; Retourne la liste des sommets d'une entité curviligne (coordonnées SCG)
(defun VerticesList (ent / n lst)
 (vl-load-com)
 (repeat (setq	n (if (vlax-curve-IsClosed ent)
	    (fix (vlax-curve-getEndParam ent))
	    (1+ (fix (vlax-curve-getEndParam ent)))
	  )
  )
   (setq lst (cons (vlax-curve-getPointAtParam ent (setq n (1- n))) lst))
 )
)

;;; 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))
   )
 )
)

[lecrabe]

 

Hello

 

Faire travailler Gilles le Dimanche du Pont du 1er Mai : quelle honte !? :)

 

Bon Dimanche Gille et Merci, Le Decapode ;)

 

 

[RhymOne]

Genial vraiment géant de travailler le dimanche pour me sortir un lisp parfait.

Maintenat vous avez reussit à regler le problemes des arcs mais j'aimerais (je sais un peu chiant) que la polyligne 3d crée au niveau des arcs soit à des intervalles regulier genre tous les 0.1 m pas en divisant l'arc en plusieurs partis, c'est très inmportant car tout vient de la, l'interpolations par divisions en n fois et moins précise que celle par pas de x.

j'éspère m'avoir fait comprendre.

J'imagine un lisp qui donnerais le choix de l'intervalles (Très fin tous les 0.001 m, Fin 0.01 m, Normal 0.1 m, Grossier 1 m, Très grossier 10m::Par exemples)

Merci encore pour l'instant le lisp de gile me suffit.