SVP Routine 3DPOLY to 2DPOLY avec conservation Xdatas et ODs

[lecrabe]

Hello

 

SVP je cherche une routine LSP qui realise la chose suivante :

- Selection AutoCAD classique

- Ne retenir dans la selection QUE les 3DPOLYs (donc eliminer les 2D POLYs, les 3D PMESHs, etc)

- Dessiner des Polylignes 2D a l'altitude de DEPART de CHAQUE Polyligne 3D

( Donc en fait c la projection verticale sur le plan de l'altitude de depart de la 3DPOLY )

 

- Si possible conserver les Xdatas d'AutoCAD

- Et si possible conserver les ODs de MAP

 

La routine doit pouvoir tourner aussi bien sur un AutoCAD, ACAD Architecture, ACAD MEP, etc

que sur un AutoCAD MAP, ACAD CIVIL (qui savent gerer les ODs)

 

Merci d'avance, LA SANTE, Bonne Annee, Bye, lecrabe

 

PS: A priori je n'ai pas dans mon stock de 2000 routines ...

[GEGEMATIC]

Salut vieux Crabe,

je pensais à un export shapes puis import, c'était bon pour les od ...

mais là ton truc c'est plus compliqué.

je peux te le faire, mais avec une kirielle de dépendance, une usine à gaz ...

a+

Gégé

[lecrabe]

Hello

 

Il faut que ÇA tourne sur n importe quel AutoCAD!

 

Pas question de passer par du MAPIMPORT / MAPEXPORT ... Qui n est possible que sur MAP ou CIVIL

 

Bye, lecrabe

[(gile)]

Salut,

 

Vite fait à partir de vieux trucs.

Ça ne traite pas les OD.

 

(defun c:p3d2d (/ *error* ss elev xdataType xdataValue)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (defun *error* (msg)
   (and msg
 (/= mas "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )
 (if (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8)))
   (progn
     (vla-StartUndoMark *acdoc*)
     (vlax-for	p3d (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(setq elev (caddr (vlax-curve-getStartPoint p3d))
      p2d  (vlax-invoke
	     (if (= 1 (getvar 'cvport))
	       (vla-get-PaperSpace *acdoc*)
	       (vla-get-ModelSpace *acdoc*)
	     )
	     'addLightWeightPolyline
	     (apply
	       'append
	       (mapcar '(lambda	(x)
			  (list (car x) (cadr x))
			)
		       (3d-coord->pt-lst (vlax-get p3d 'Coordinates))
	       )
	     )
	   )
)
(vla-put-Closed p2d (vla-get-Closed p3d))
(vla-put-Elevation p2d elev)
(vla-GetXdata p3d "" 'xdataType 'xdataValue)
(if xdataType
  (vla-SetXdata p2d xdataType xdataValue)
)
     )
     (vla-delete ss)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (*error* nil)
)

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

[bonuscad]

Salut,

Comme tu m'avais rafraîchi la mémoire lors de ce post

En adaptant rapidement le lisp posté (juste changé le filtre de sélection de départ), cela donnerai ce qui suit, je n'ai pas trop testé mais ça devrait aller...

(defun c:LECRABE ( / js n ent dxf_obj xd_l l_10 l_40 l_41 l_42 dxf_39 e_next dxf_next dxf_43 dxf_38 lst_data nwent tbldef)
 (setq js (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))
 (cond
(js
 	(repeat (setq n (sslength js))
   	(setq
     	dxf_obj (entget (setq ent (ssname js (setq n (1- n)))) (list "*"))
     	l_10 nil l_40 nil l_41 nil l_42 nil
     	xd_l (assoc -3 dxf_obj)
   	)
   	(if (cdr (assoc 39 dxf_obj))
     	(setq dxf_39 (cdr (assoc 39 dxf_obj)))
     	(setq dxf_39 0.0)
   	)
   	(setq e_next (entnext (cdar dxf_obj)))
   	(if (zerop (boole 1 1 (cdr (assoc 70 dxf_obj))))
     	(setq flag_cl nil)
     	(setq flag_cl T)
   	)
   	(if (zerop (boole 1 4 (cdr (assoc 70 dxf_obj))))
     	(setq flag_sp nil)
     	(setq flag_sp T)
   	)
   	(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
     	(if (zerop (boole 1 (cdr (assoc 70 dxf_next)) 16))
       	(setq
         	l_10 (cons (cdr (assoc 10 dxf_next)) l_10)
         	l_40 (cons (cdr (assoc 40 dxf_next)) l_40)
         	l_41 (cons (cdr (assoc 41 dxf_next)) l_41)
         	l_42 (cons (cdr (assoc 42 dxf_next)) l_42)
       	)
     	)
     	(setq e_next (entnext e_next))
   	)
   	(setq
     	l_10 (reverse l_10)
     	l_40 (reverse l_40)
     	l_41 (reverse l_41)
     	l_42 (mapcar '(lambda (x) (cons 42 x)) (reverse l_42))
   	)
   	(if (and (equal (apply 'max l_40) (apply 'min l_40)) (equal (apply 'max l_41) (apply 'min l_41)))
     	(setq dxf_43 (car l_40) l_40 nil l_41 nil)
     	(setq
       	dxf_43 nil
       	l_40 (mapcar '(lambda (x) (cons 40 x)) l_40)
       	l_41 (mapcar '(lambda (x) (cons 41 x)) l_41)
     	)
   	)
   	(if (not (zerop (caddar l_10)))
     	(setq dxf_38 (caddar l_10))
     	(setq dxf_38 0.0)
   	)
   	(setq l_10 (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) l_10))
   	(entmake
     	(append
       	(list
         	(cons 0 "LWPOLYLINE")
         	(cons 100 "AcDbEntity")
         	(assoc 67 dxf_obj)
         	(assoc 410 dxf_obj)
         	(assoc 8 dxf_obj)
         	(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
         	(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
         	(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
         	(cons 100 "AcDbPolyline")
         	(cons 90 (length l_10))
         	(cons 70
           	(if (zerop (boole 1 (rem (cdr (assoc 70 dxf_obj)) 128) 1))
             	(boole 1 (cdr (assoc 70 dxf_obj)) 128)
             	(1+ (boole 1 (cdr (assoc 70 dxf_obj)) 128))
           	)
         	)
         	(cons 38 dxf_38)
         	(cons 39 dxf_39)
       	)
       	(if (and l_40 l_41)
         	(apply 'append
           	(mapcar
             	'(lambda (x10 x40 x41 x42)
               	(append (list x10 x40 x41 x42))
             	)
             	l_10 l_40 l_41 l_42
           	)
         	)
         	(progn
           	(cons 43 dxf_43)
           	(apply 'append
             	(mapcar
               	'(lambda (x10 x42)
                 	(list x10 x42)
               	)
               	l_10 l_42
             	)
           	)
         	)
       	)
       	(list (assoc 210 dxf_obj))
       	(if xd_l (list xd_l) '())
     	)
   	)
   	(if
     	(or
       	(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
       	(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
     	)
     	(progn
       	(setq lst_data nil nwent (entlast))
       	(foreach n (ade_odgettables ent)
         	(setq tbldef (ade_odtabledefn n))
         	(setq lst_data (cons (mapcar '(lambda (fld) (cons n (cons fld (ade_odgetfield ent n fld 0)))) (mapcar 'cdar (cdr (nth 2 tbldef)))) lst_data))
       	)
       	(cond
         	(lst_data
           	(mapcar '(lambda (x) (ade_odaddrecord nwent (caar x)) (foreach el x (ade_odsetfield nwent (car el) (cadr el) 0 (cddr el)))) lst_data)
         	)
       	)
     	)
   	)
   	(entdel ent)
 	)
)
 )
 (princ "\n") (princ (itoa (sslength js))) (princ " 3DPolylignes converties en LWPolylignes ")
 (prin1) 
)

 

[COME]

Bonjour,

 

Bonuscad je viens de tester vite fait et cela fonctionne correctement, les poly 3D sont bien transformées en LWPolylignes avec l'élévation correspondant au "z" du 1er point de la 3D.

 

Merci et bonne journée !

[lecrabe]

Hello Gilles & Bruno

 

Merci & Merci !

 

LA SANTÉ, Bye, lecrabe

 

PS: les "Vieux" Gilles et Bruno sont gentils avec le "Vieux" Decapode !