Conversion Polyligne 2D en Polyligne 3D

[lecrabe]

 

Hello

 

J'etais pourtant sur d'avoir ce genre de routine !

et pourtant je ne la retrouve pas ... :o

 

J'ai cherche sur le forum et je n'ai pas trouve !! :(

Je pense que cette routine a deja ete developpee :mad:

 

Donc quelqu'un peut il m'aider svp ?

 

Le Decapode "fatigue ce matin"

 

[Raph_38]

Tiens, j'ai celui-ci en stock je ne sais plus qui est l'auteur mais je crois que Giles est intervenu dessus)

 

(defun c:line2poly3d (/ AcDoc ss n line poly)
(vl-load-com)
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(if (setq ss (ssget '((0 . "LINE"))))
(repeat (setq n (sslength ss))
(setq line (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(setq poly
(vlax-invoke
(if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
'Add3dpoly
(apply
'append
(list (vlax-get line 'StartPoint) (vlax-get line 'EndPoint))
)
)
)
(foreach p (list 'Layer 'LineType 'LineTypeScale
'LineWeight 'Color 'TrueColor
)
(if (and (vlax-property-available-p line p)
(vlax-property-available-p poly p)
)
(vlax-put poly p (vlax-get line p))
)
)
(vla-delete line)
)
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(princ)
)

[lecrabe]

 

Hello

 

Merci beaucoup, mais si qq'un a le meme genre de routine qui traite aussi directement les Polylignes 2D, je suis preneur ! :)

 

Cela m'evitera de decomposer/exploser mes jolies polylignes ! :exclam:

 

Le Decapode "content quand meme"

 

[lecrabe]

 

ReHello

 

Ca y est, j'ai enfin retrouve la BONNE routine de Gilles (comme d'habitude) ! :)

 

Elle se nomme CONVERT3D et c'est pourquoi je ne l'ai pas retrouve !! :o

 

Sorry pour le derangement, Le Decapode "honteux"

 

[Raph_38]

Et pour ceux que ça intéresse je remets le code ici :

 

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

)

[Bred]

Salut, j'avais fait ça ici

 

[Edité le 29/9/2009 par Bred]

[RhymOne]

Bonjour,

Je rebondis sur ce sujet en plus de ceux que j'ai déja posté.

Les polyligne sont souvent avec des arcs donc la sa bloque.

Le lisp marche nikel mais ne gere pas les arcs j'aimerais une discrtisation de 0.1 par exemple..

Merci d'avance...

[lecrabe]

 

Hello

 

Comme d'habitude, Gilles avait deja frappe suite a ma demande !

 

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=21509#pid91177

 

Encore Merci a Gilles, Bonuscad, Patrick35, Matt666, etc - Le Decapode

 

 

[RhymOne]

(Re)Bonjour,

Oui le crabe c'est tres bien tout sa il y a rien à dire j'avais deja vu ce poste mais pour ma part ce n'est pas ce qu'il me faut.

Moi j'aimerais que les arcs transformé ou cercle soit discretisé celon un paramètre par exemple 0.01.Donc chaque segment aura comme distance la longueur de l'arc *0.01.

 

j'espère avoir etait clair...

[lecrabe]

 

Hello

 

Une routine de Gilles qui transforme les cercles en polygones

 

Le Decapode

 

 

;;; C2PG (gile)
;;; Transforme les cercles sélectionnés en polygones.
;;; http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=20225#pid84252

(defun c:c2pg (/ space nb ss n dist nor pt lst pline xdatatype xdatavalue)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq Space (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
)
)
(if (ssget '((0 . "CIRCLE")))
(progn
(initget 6)
(or
(setq nb (getint "\nEntrez le nombre de segments : "))
(setq nb 32)
)
(vla-StartUndoMark *acdoc*)
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(setq dist (/ (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
nb
)
nor (vlax-get obj 'Normal)
lst nil
n 0
)
(repeat nb
(setq
lst
(cons
(vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
lst
)
)
)
(setq lst (apply 'append
(mapcar
'(lambda (x)
(setq x (trans x 0 nor))
(list (car x) (cadr x))
)
(reverse lst)
)
)
)
(setq pline (vlax-Invoke Space 'addLightweightPolyline lst))
(vla-put-Closed pline T)
(vla-put-Normal pline (vlax-3d-point nor))
(vla-put-Elevation pline (caddr (trans (vlax-curve-getStartPoint obj) 0 nor)))
(vla-getXData obj "" 'xdatatype 'xdatavalue)
(and xdatatype xdatavalue (vla-setXData pline xdatatype xdatavalue))
)
(vla-EndUndoMark *acdoc*)
(vla-delete ss)
)
)
(princ)
)  

 

 

 

 

[RhymOne]

Bonjour,

Mais ou est la discretisation????