CADxp: SVP Routine 3DPOLY to 2DPOLY avec conservation Xdatas et ODs - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

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

#1 L'utilisateur est hors-ligne   lecrabe 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8368
  • Inscrit(e) : 10-décembre 03
  • LocationLoire (42)

Posté 09 janvier 2019 - 15:48

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 ...
Autodesk Expert Elite Team
0

#2 L'utilisateur est hors-ligne   GEGEMATIC 

  • ceinture noire 1er dan
  • Groupe : Membres
  • Messages : 842
  • Inscrit(e) : 04-novembre 05

Posté 09 janvier 2019 - 18:06

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é
---------------------------------------------------------------------- PowerClic sur http://www.g-eaux.com
0

#3 L'utilisateur est hors-ligne   lecrabe 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8368
  • Inscrit(e) : 10-décembre 03
  • LocationLoire (42)

Posté 09 janvier 2019 - 18:11

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
Autodesk Expert Elite Team
0

#4 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11181
  • Inscrit(e) : 02-septembre 05

Posté 09 janvier 2019 - 20:00

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
Image IPB
0

#5 L'utilisateur est hors-ligne   bonuscad 

  • ceinture rouge et blanche 8em dan
  • Groupe : Membres
  • Messages : 4657
  • Inscrit(e) : 20-juin 03

Posté 09 janvier 2019 - 22:02

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


Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius
0

#6 L'utilisateur est hors-ligne   COME 

  • ceinture noire
  • Groupe : Membres
  • Messages : 408
  • Inscrit(e) : 16-septembre 13

Posté 10 janvier 2019 - 08:09

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 !
COME

La vie sans musique est tout simplement une erreur, une fatigue, un exil. »
Friedrich Nietzsche
0

#7 L'utilisateur est hors-ligne   lecrabe 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8368
  • Inscrit(e) : 10-décembre 03
  • LocationLoire (42)

Posté 10 janvier 2019 - 10:28

Hello Gilles & Bruno

Merci & Merci !

LA SANTÉ, Bye, lecrabe

PS: les "Vieux" Gilles et Bruno sont gentils avec le "Vieux" Decapode !
Autodesk Expert Elite Team
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)