Transformer Polyligne en région...

Bred · le 3 novembre 2006

Salut,

J'ai une mauvaide surprise sur la 2007 : Le calcul du rendu ne prend pas en comptes les polylignes larges pour les ombres... (sa fonctionnait sur 2006...)

et j'ai pas mal de bloc (3D) fait avec des polylignes larges en guise de surface.

Je voudrais savoir si quelqu'un n'aurait pas un petit lisp dans ses tiroires permettant de transformer des polyligne en région... ceci permettant d'automatiser le tâche...

merci d'avance.

didier · le 3 novembre 2006

coucou,

la première réponse qui me vient est celle-ci

(setq ent (car(entsel"\npolyligne ?\n")))

(command "region" ent "" )

maintenant pour automatiser, je te laisse détecter

les Polylignes avec des filtres...

amicalement

Bred · le 3 novembre 2006

merci... mais ça n'est pas ça !!!

=>ex : j'ai une polyligne "simple" de 1.00 de longueur, et de 0.2 de largeur (uniforme)

et je voudrais : une région qui soit une surface rectangulaire de 1.00 x 0.20 ....

didier · le 3 novembre 2006

hello,

désolé d'avoir mal compris ...

ciao

(gile) · le 3 novembre 2006

Salut,

C'est "brut de coffrage" et pas testé en profondeur, mais tu sauras l'améliorer ;)

PS : ça ne fonctionne qu'avec les polylignes de largeur constante.

(defun c:pl2r (/ os ec ss1 elst wid p1 p2 ang ss2 pl1 pl2)
 (setq	os (getvar "osmode")
ec (getvar "cmdecho")
 )
 (if (setq ss1 (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
(setq elst (entget pl)
      wid  (/ (cdr (assoc 43 elst)) 2)
      p1   (trans (append (cdr (assoc 10 elst))
			  (list (cdr (assoc 38 elst)))
		  )
		  pl
		  1
	   )
      p2   (trans
	     (append
	       (cdr (assoc 10 (cdr (member (assoc 10 elst) elst))))
	       (list (cdr (assoc 38 elst)))
	     )
	     pl
	     1
	   )
      ang  (angle p1 p2)
      ss2  (ssadd)
)
(command "_.offset"
	 wid
	 pl
	 (polar p1 (+ ang (* pi 0.5)) 1.0)
	 ""
)
(setq pl1 (entlast))
(entmod
  (subst '(43 . 0) (assoc 43 (entget pl1)) (entget pl1))
)
(ssadd pl1 ss2)
(command "_.offset"
	 wid
	 pl
	 (polar p1 (+ ang (* pi 1.5)) 1.0)
	 ""
)
(setq pl2 (entlast))
(entmod
  (subst '(43 . 0) (assoc 43 (entget pl2)) (entget pl2))
)
(ssadd pl2 ss2)
(command "_.line"
	 (trans	(append	(cdr (assoc 10 (entget pl1)))
			(list (cdr (assoc 38 (entget pl1))))
		)
		pl1
		1
	 )
	 (trans	(append	(cdr (assoc 10 (entget pl2)))
			(list (cdr (assoc 38 (entget pl2))))
		)
		pl2
		1
	 )
	 ""
)
(ssadd (entlast) ss2)
(command "_.line"
	 (trans	(append	(cdr (assoc 10 (reverse (entget pl1))))
			(list (cdr (assoc 38 (entget pl2))))
		)
		pl1
		1
	 )
	 (trans	(append	(cdr (assoc 10 (reverse (entget pl2))))
			(list (cdr (assoc 38 (entget pl2))))
		)
		pl2
		1
	 )
	 ""
)
(ssadd (entlast) ss2)
(command "_.region" ss2 "")
(command "_.erase" ss2 "")
     )
   )
 )
 (setvar "osmode" os)
 (setvar "cmdecho" ec)
 (princ)
)

[Edité le 3/11/2006 par (gile)]

Bred · le 3 novembre 2006

merci (gile) !

(c'est même mieux que je ne l'espérait : le lisp prend en compte les polylignes à plusieurs sommets !)

:D :D :D

(gile) · le 3 novembre 2006

Qui dit ombre dit 3D, j'ai donc un peu modifié le LISP pour qu'il fonctionne quelque soient le SCU courant et les SCO des polylignes.

Bred · le 3 novembre 2006

merci (gile).

j'ai legerement modifié ton lisp pour qu'il fonctionne avec les polylignes fermées, mais j'ai un bug que je ne comprend pas : :casstet:

Lorsque j'ai UNE polyligne fermée, ça fontionne.

Par contre, quand j'ai plusieurs polylignes (certaines fermées et d'autre non), cela me suprime les formes fermée...

(ce que j'ai rajouté est en gras)

(defun c:pl2r (/ os ec ss1 elst wid p1 p2 ang ss2 pl1 pl2)
 
 (setq	os (getvar "osmode")
ec (getvar "cmdecho"))
 
 (if (setq ss1 (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
(setq elst (entget pl)
      wid  (/ (cdr (assoc 43 elst)) 2)
      p1   (trans (append (cdr (assoc 10 elst))(list (cdr (assoc 38 elst)))) pl 1)
      p2   (trans (append (cdr (assoc 10 (cdr (member (assoc 10 elst) elst))))
			  (list (cdr (assoc 38 elst)))) pl 1)
      ang  (angle p1 p2)
      ss2  (ssadd))

(command "_.offset" wid	 pl (polar p1 (+ ang (* pi 0.5)) 1.0) "")
(setq pl1 (entlast))(entmod (subst '(43 . 0) (assoc 43 (entget pl1)) (entget pl1)))
(ssadd pl1 ss2)
[b](if (equal (cdr (assoc 70 elst)) 1) (setq sel1 pl1))[/b]

(command "_.offset" wid	pl (polar p1 (+ ang (* pi 1.5)) 1.0) "") 
(setq pl2 (entlast))	
(entmod (subst '(43 . 0) (assoc 43 (entget pl2)) (entget pl2)))
(ssadd pl2 ss2)
[b](if (equal (cdr (assoc 70 elst)) 1) (setq sel2 pl2))[/b]

[b](if (equal (cdr (assoc 70 elst)) 1)
  (progn
    (command "_.region" pl1 "")(setq reg1 (entlast))
    (command "_.region" pl2 "")(setq reg2 (entlast))
    (command "_subtract" reg1 "" reg2 "")	  
  )[/b]
  (progn
    (command "_.line" (trans (append (cdr (assoc 10 (entget pl1)))
				 (list (cdr (assoc 38 (entget pl1))))) pl1 1)
	 (trans	(append	(cdr (assoc 10 (entget pl2)))
			(list (cdr (assoc 38 (entget pl2))))) pl2 1) "")
    (ssadd (entlast) ss2)

    (command "_.line" (trans (append (cdr (assoc 10 (reverse (entget pl1))))
				 (list (cdr (assoc 38 (entget pl2))))) pl1 1)
	 (trans (append	(cdr (assoc 10 (reverse (entget pl2))))
			(list (cdr (assoc 38 (entget pl2))))) pl2 1) "")
    (ssadd (entlast) ss2)

    (command "_.region" ss2 "")	    
  )
  )
(command "_.erase" ss2 "")	  
     )
   )    
 )
 [b](command "_.erase" ss1 "")[/b];;;supression polylignes  
 (setvar "osmode" os)
 (setvar "cmdecho" ec)
 (princ)
)

Bred · le 3 novembre 2006

mmmmm....

je pense avoir décelé le bug : c'est au moment de la soustration des régions, elles s'annulent !!!...

Bred · le 3 novembre 2006

Et bien (gile), je pense que tu seras fière de l'un de tes nombreux éleve ;) : j'ai réparé le bug en récupérant le périmètre des polylignes...

merci pour tout !!!

édition modif :

- récupération calque + couleur

- correction bug par rapport au sens de décalage (?)

(defun c:pl2r (/ os ec ss1 elst wid p1 p2 ang ss2 pl1 pl2 reg1 per1 reg2 per2)
 
 (setq	os (getvar "osmode")
ec (getvar "cmdecho"))
 
 (if (setq ss1 (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))) ;(setq pl (ssname ss1 0))
(setq elst (entget pl)
      wid  (/ (cdr (assoc 43 elst)) 2)
      p1   (trans (append (cdr (assoc 10 elst))(list (cdr (assoc 38 elst)))) pl 1)
      p2   (trans (append (cdr (assoc 10 (cdr (member (assoc 10 elst) elst))))
			  (list (cdr (assoc 38 elst)))) pl 1)
      ang  (angle p1 p2)
      ss2  (ssadd)
      lay (cdr (assoc 8 elst))
      col (cdr (assoc 62 elst)))

(command "_.offset" wid	 pl (polar p1 (+ ang (* pi 0.5)) 1.0) "")
(setq pl1 (entlast))(entmod (subst '(43 . 0) (assoc 43 (entget pl1)) (entget pl1)))
(ssadd pl1 ss2)
(if (equal (cdr (assoc 70 elst)) 1)
  (progn
    (setq sel1 pl1)
    (command "_.area" "_o" sel1)
    (setq per1 (getvar "perimeter"))))

(command "_.offset" wid	pl (polar p1 (+ ang (* pi 1.5)) 1.0) "") 
(setq pl2 (entlast))(entmod (subst '(43 . 0) (assoc 43 (entget pl2)) (entget pl2)))
(ssadd pl2 ss2)
(if (equal (cdr (assoc 70 elst)) 1)
  (progn
    (setq sel2 pl2)
    (command "_.area" "_o" sel2)
    (setq per2 (getvar "perimeter"))
   [b] (if (= per1 per2)
      (progn
	(command "_.offset" (* 2 wid) pl2 (polar p1 (+ ang (* pi -1.5)) 1.0) "")
	(ssadd pl2 ss2)
	(setq sel2 pl2)
	(command "_.area" "_o" sel2)
	(setq per2 (getvar "perimeter"))
	)
      )[/b]
    )
  )

(if (equal (cdr (assoc 70 elst)) 1)
  (progn	    
    (command "_.region" pl1 "")(setq reg1 (entlast))
    (command "_.region" pl2 "")(setq reg2 (entlast))
    (if (> per1 per2)
      (command "_subtract" reg1 "" reg2 "")
      (command "_subtract" reg2 "" reg1 "")	      
      )
    (command "_change" (entlast) "" "p" "ca" lay
	     				"co" col "")
  )
  (progn
    (command "_.line" (trans (append (cdr (assoc 10 (entget pl1)))
				 (list (cdr (assoc 38 (entget pl1))))) pl1 1)
	 (trans	(append	(cdr (assoc 10 (entget pl2)))
			(list (cdr (assoc 38 (entget pl2))))) pl2 1) "")
    (ssadd (entlast) ss2)

    (command "_.line" (trans (append (cdr (assoc 10 (reverse (entget pl1))))
				 (list (cdr (assoc 38 (entget pl2))))) pl1 1)
	 (trans (append	(cdr (assoc 10 (reverse (entget pl2))))
			(list (cdr (assoc 38 (entget pl2))))) pl2 1) "")
    (ssadd (entlast) ss2)

    (command "_.region" ss2 "")
    (command "_change" (entlast) "" "p" "ca" lay
	     				"co" col "")
  )
  )
(command "_.erase" ss2 "")	  
     )
   )    
 )
 (command "_.erase" ss1 "")  
 (setvar "osmode" os)
 (setvar "cmdecho" ec)
 (princ)
)

[Edité le 4/11/2006 par Bred]

Bred · le 4 novembre 2006

J'ai éditer le code car j'avais un bug que je ne comprend pas : :casstet:

Le décalage se faisait quelquefois dans le même sens !... (j'ai l'impression selon le sens déssiné de la polygne...)

J'ai donc fait un test sur le périmètre, et si j'ai égalité je refait un décalage en négatif....

... pas trés jolie, mais ça fonctionne... :exclam:

(gile) · le 4 novembre 2006

Re,

Voici une version en VisualLISP qui devrait fonctionner dans tous les cas (vla-offset décale d'un côté ou de l'autre suivant le signe de la distance de décalage).

;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D (Coordinates)
;;; en liste de points 3D (SCG).
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0 0.0) (3.0 4.0 0.0))

(defun 2d-coord->pt-lst	(lst elv norm)
 (if lst
   (cons (trans (list (car lst) (cadr lst) elv) norm 0)
  (2d-coord->pt-lst (cddr lst) elv norm)
   )
 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (vla-StartUndoMark AcDoc)
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq pl  (vlax-ename->vla-object pl)
      wid (vla-get-ConstantWidth pl)
      lst (append (vlax-invoke pl 'Offset (/ wid 2))
		  (vlax-invoke pl 'Offset (/ wid -2))
	  )
)
(mapcar '(lambda (x) (vla-put-ConstantWidth x 0.0)) lst)
(if (= (vla-get-Closed pl) :vlax-true)
  (progn
    (setq reg (vlax-invoke Space 'addRegion lst))
    (if	(	      (vla-Boolean (cadr reg) acSubtraction (car reg))
      (vla-Boolean (car reg) acSubtraction (cadr reg))
    )
  )
  (progn
    (mapcar '(lambda (sym obj)
	       (set sym
		    (2d-coord->pt-lst
		      (vlax-get obj 'Coordinates)
		      (vlax-get obj 'Elevation)
		      (vlax-get obj 'Normal)
		    )
	       )
	     )
	    '(pt1 pt2)
	    lst
    )
    (setq lst (append (list (vla-addLine
			      Space
			      (vlax-3d-point (car pt1))
			      (vlax-3d-point (car pt2))
			    )
		      )
		      (list (vla-addLine
			      Space
			      (vlax-3d-point (last pt1))
			      (vlax-3d-point (last pt2))
			    )
		      )
		      lst
	      )
    )
    (vlax-invoke Space 'addRegion lst)
  )
)
(vla-delete pl)
     )
     (mapcar 'vla-delete lst)
     (vla-EndUndoMark AcDoc)
   )
 )
 (princ)
)

[Edité le 4/11/2006 par (gile)]

Bred · le 4 novembre 2006

Re-merci (gile).... :D

(gile) · le 4 novembre 2006

J'ai un peu remanié le LISP, juste une question de style, le fonctionnement est identique.

Bred · le 4 novembre 2006

Salut (gile),

je me suis permis de rajouter à ton lisp la récupération du calque et de la couleur.

Dailleur j'imagine qu'il y a une écriture plus "propre" que mon "(vlax-put-property (vlax-ename->vla-object (entlast)) 'Layer lay)" ...

J'ai aussi déplacer le "(mapcar 'vla-delete lst)" en fin de code, car seul les lignes d'un seul objet modifié était suprimé.

(defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2 Lay col)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
	))
 
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (vla-StartUndoMark AcDoc)
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) 
(setq pl  (vlax-ename->vla-object pl)
      wid (vla-get-ConstantWidth pl) ;larg polyligne
     [i] Lay (vla-get-Layer pl) ; Calque
      col (vla-get-Color pl)) ; Couleur[/i]

(setq lst (append (vlax-invoke pl 'Offset (/ wid 2)) 
		  (vlax-invoke pl 'Offset (/ wid -2)))) ;décalages

(mapcar '(lambda (x) (vla-put-ConstantWidth x 0.0)) lst) ;polyligne décalé à largeur 0

(if (= (vla-get-Closed pl) :vlax-true)
  (progn
    (setq reg (vlax-invoke Space 'addRegion lst))
    (if	(< (vla-get-Area (car reg)) (vla-get-Area (cadr reg)))
      (vla-Boolean (cadr reg) acSubtraction (car reg))
      (vla-Boolean (car reg) acSubtraction (cadr reg))	       
    )
   [i] (vlax-put-property (vlax-ename->vla-object (entlast)) 'Layer lay)
    (vlax-put-property (vlax-ename->vla-object (entlast)) 'Color col)[/i]
  )
  (progn
    (mapcar '(lambda (sym obj)
	       (set sym (2d-coord->pt-lst
			  (vlax-get obj 'Coordinates)
			  (vlax-get obj 'Elevation)
			  (vlax-get obj 'Normal)))) '(pt1 pt2) lst)
    
    (setq lst (append (list (vla-addLine Space
			      (vlax-3d-point (car pt1))
			      (vlax-3d-point (car pt2))))
		      (list (vla-addLine
			      Space
			      (vlax-3d-point (last pt1))
			      (vlax-3d-point (last pt2)))) lst))
    
    (vlax-invoke Space 'addRegion lst)	    
  )
)	
[i](vlax-put-property (vlax-ename->vla-object (entlast)) 'Layer lay)
(vlax-put-property (vlax-ename->vla-object (entlast)) 'Color col)[/i]
(vla-delete pl)
[b](mapcar 'vla-delete lst)[/b]
     )      
     (vla-EndUndoMark AcDoc)
   ) 
 )
 (princ)
)

merci !!!

[Edité le 21/12/2006 par Bred]

(gile) · le 5 novembre 2006

Bien vu, (mapcar 'vla-delete lst) était mal placé.

Ton (vlax-put-property (vlax-ename->vla-object (entlast)) 'Layer lay) est propre et efficace.

On peut néanmoins gagner quelques lignes :

;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D (Coordinates)
;;; en liste de points 3D (SCG).
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0 0.0) (3.0 4.0 0.0))

(defun 2d-coord->pt-lst (lst elv norm)
(if lst
(cons (trans (list (car lst) (cadr lst) elv) norm 0)
(2d-coord->pt-lst (cddr lst) elv norm)
)
)
)


(defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (vla-StartUndoMark AcDoc)
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq pl  (vlax-ename->vla-object pl)
      wid (vla-get-ConstantWidth pl)
      lst (append (vlax-invoke pl 'Offset (/ wid 2))
		  (vlax-invoke pl 'Offset (/ wid -2))
	  )
)
(if (= (vla-get-Closed pl) :vlax-true)
  (progn
    [b](setq reg (vlax-invoke Space 'addRegion lst))
    (if	(	      (setq reg (reverse reg))
    )
    (vla-Boolean (car reg) acSubtraction (cadr reg))
    (setq reg (car reg))[/b]
  )
  (progn
    (mapcar '(lambda (sym obj)
	       (set sym
		    (2d-coord->pt-lst
		      (vlax-get obj 'Coordinates)
		      (vlax-get obj 'Elevation)
		      (vlax-get obj 'Normal)
		    )
	       )
	     )
	    '(pt1 pt2)
	    lst
    )
    (setq lst (append (list (vla-addLine
			      Space
			      (vlax-3d-point (car pt1))
			      (vlax-3d-point (car pt2))
			    )
		      )
		      (list (vla-addLine
			      Space
			      (vlax-3d-point (last pt1))
			      (vlax-3d-point (last pt2))
			    )
		      )
		      lst
	      )
    )
    [b](setq reg (car (vlax-invoke Space 'addRegion lst)))[/b]
  )
)
[b](vla-put-Layer reg lay)
(vla-put-Color reg col)[/b]
(mapcar 'vla-delete lst)
(vla-delete pl)
     )
     (vla-EndUndoMark AcDoc)
   )
 )
 (princ)
)

PS : Les variables lay et col ne sont pas définies dans le LISP. Avec les versions antérieures, les régions sont créées sur le calque courant dans la couleur courante ...

[Edité le 5/11/2006 par (gile)]

Bilbeau · le 5 novembre 2006

Sans vouloir vous embêter, ça serait pas plus simple de convertir chaque segment par une 3dface ou l'ensemble par une pmesh (dans ce dernier cas, on garde l'intégrité de l'objet) ? Les 3 dfaces et pmesh c'est ce qui est rendu de toute façon par le render qualque soit la version ou autre type de logiciel. Dans ce cas le problème des segments non linéaires ou avec épaisseur va commencer à se poser. Donc, en supposant qu'il y a une épaisseur, il faut ajouter des faces/pmesh pour les faces de hauteur. Dans le cas de présence d'arcs il faudra utiliser des surfaces règlées pour chaque face (0, 2 ou 4) pour chaque ségement), et dans le cas de bspline 2 ou 3, ben c'est la galère ( :casstet: ), mais bon c'est tout aussi faisable.

Dans tous les cas il est utiles de garder une option de conversion en solide ou pmesh.

(gile) · le 5 novembre 2006

Sans vouloir vous embêter, ça serait pas plus simple de convertir chaque segment par une 3dface ou l'ensemble par une pmesh ...

Peut-être, mais la demande est de transformer des polylignes de largeur constante en régions, et la dernière routine semble répondre à la demande, alors ...

mikL44 · le 5 novembre 2006

Bonjour

Ca vient de chez moi ou le lisp ne fonctionne plus depuis la correction du 05/11 ?

(gile) · le 5 novembre 2006

Salut Boris,

Toutes mes excuses, dans la discussion avec Bred pour améliorer la routine principale j'ai oublié de recopier la sous routine 2d-coord->pt-lst qui transforme la liste retourne par (vlax-get obj 'Coordinates) en liste de oints 3D dans le SCG.

Je répare cet oubli.

mikL44 · le 5 novembre 2006

s'il te plait Gile ne t'excuses pas, tu nous livre la un lisp bien pratique.

Je viens de le tester, la region se construit bien, parcontre il se construit aussi 2 polylignes identiques à la premiere de chaque coté de celle ci.

(gile) · le 5 novembre 2006

Re,

Je pense que ça vient des deux lignes :

(vla-put-Layer reg lay)

(vla-put-Color reg col)

à la fin du LISP.

Le LISP répondait à un besoin spécifique et certaines modifications ont été apportées par Bred, je lui disais à ce sujet :

PS : Les variables lay et col ne sont pas définies dans le LISP

Puisque ce LISP semble en intéresser d'autres, je remet ci-dessous une version plus polyvalente.

;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D (Coordinates)
;;; en liste de points 3D (SCG).
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0 0.0) (3.0 4.0 0.0))

(defun 2d-coord->pt-lst	(lst elv norm)
 (if lst
   (cons (trans (list (car lst) (cadr lst) elv) norm 0)
  (2d-coord->pt-lst (cddr lst) elv norm)
   )
 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0))))
   (progn
     (vla-StartUndoMark AcDoc)
     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq pl  (vlax-ename->vla-object pl)
      wid (vla-get-ConstantWidth pl)
      lst (append (vlax-invoke pl 'Offset (/ wid 2))
		  (vlax-invoke pl 'Offset (/ wid -2))
	  )
)
(if (= (vla-get-Closed pl) :vlax-true)
  (progn
    (setq reg (vlax-invoke Space 'addRegion lst))
    (if	(	      (setq reg (reverse reg))
    )
    (vla-Boolean (car reg) acSubtraction (cadr reg))
  )
  (progn
    (mapcar '(lambda (sym obj)
	       (set sym
		    (2d-coord->pt-lst
		      (vlax-get obj 'Coordinates)
		      (vlax-get obj 'Elevation)
		      (vlax-get obj 'Normal)
		    )
	       )
	     )
	    '(pt1 pt2)
	    lst
    )
    (setq lst (append (list (vla-addLine
			      Space
			      (vlax-3d-point (car pt1))
			      (vlax-3d-point (car pt2))
			    )
		      )
		      (list (vla-addLine
			      Space
			      (vlax-3d-point (last pt1))
			      (vlax-3d-point (last pt2))
			    )
		      )
		      lst
	      )
    )
    (vlax-invoke Space 'addRegion lst)
  )
)
(mapcar 'vla-delete lst)
(vla-delete pl)
     )
     (vla-EndUndoMark AcDoc)
   )
 )
 (princ)
)

mikL44 · le 5 novembre 2006

Ca marche nickel, merci Bred, merci Gile beau boulot

Connexion

Transformer Polyligne en région...

Messages recommandés

Bred

didier

Bred

didier

(gile)

Bred

(gile)

Bred

Bred

Bred

Bred

(gile)

Bred

(gile)

Bred

(gile)

Bilbeau

(gile)

mikL44

(gile)

mikL44

(gile)

mikL44

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante