Fusion de plusieurs polylignes

[fabcad]

Auriez vous une routine ou des bouts de programme qui fusionne plusieurs polylignes fermées en une seule.

Merci d'avance...

[lecrabe]

 

Hello Fab

 

Je n'ai pas bien compris ton cahier des charges ! :o

 

Est ce à partir de N polylignes closes "mitoyennes" (par exemple des parcelles)

de générer la polyligne close "englobante" ?

 

Ou autre chose ... :casstet:

 

Le Decapode

 

[Tramber]

Je n'ai pas (tout) compris non plus.

 

Faire une région par opérations booléennes puis un contour pour générer une poly est fastidieux mais semble correspondre à ton idée.

[fabcad]

Pour LECRABE

Oui c'est à partir de N polylignes parcelles closes de générer la polyligne close "englobante" ?

bien sur avec un autocad.

 

Cela est fastidieux de convertir un grand nombre de parcelles en régions puis de les fusionner.

 

Je patiente...

[(gile)]

Salut,

 

Voici déjà un premier jet, à partir des polylignes sélectionnées un région est créée, elle est mise en surbrillance, les polylignes source ne sont pas effacées.

 

Si tu veux supprimer les polylignes source, transformer la région en polyligne, merci de préciser la demande, je verrais ce que je (ou d'autres) peux faire.

 

(defun c:pl2reg	(/ AcDoc Space ss lst reg)
 (vl-load-com)
 (setq	AcDoc (vla-get-activeDocument (vlax-get-acad-object))
Space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-Modelspace AcDoc)
      )
 )
 (prompt "\nSélectionnez les polylignes à fusionner: ")
 (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
   (progn
     (vla-StartUndoMark AcDoc)
     (setq
lst (mapcar 'vlax-ename->vla-object
	    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
reg (vl-catch-all-apply
      'vlax-invoke
      (list Space 'addRegion lst)
    )
     )
     (if (vl-catch-all-error-p reg)
(princ (vl-catch-all-error-message reg))
(progn
(while (cadr reg)
  (vla-boolean
    (car reg)
    acUnion
    (cadr reg)
  )
  (setq reg (cons (car reg) (cddr reg)))
)
(vla-Highlight (car reg) :vlax-true)
)
     )
     (vla-EndUndoMark AcDoc)
   )
 )
 (princ)
) 

[LUDWIG]

Et avec contour ? Un rectangle grossier autour de ton contour global, "contour" et un clic entre le rectangle et le contour extérieur des parcelles te génèrera une polyligne englobante.

[fabcad]

merci à gile pour cette première ébauche cela fonctionne vraiment bien.

Dans cette fonction pourrait-on créer une deuxième routine pour transformer ces regions englobantes en polylignes englobantes.

 

A la solution de LUDWIG il s'avère qu'après test il ne crée que des contours aléatoires (copies de parcelles et quelques polylignes englobantes.

 

Merci d'avance et quel brio.

 

[(gile)]

J'ai jouté une ancienne routine que j'avais.

 

(defun c:fusion	(/ AcDoc Space ss lst reg)
 (vl-load-com)
 (setq	AcDoc (vla-get-activeDocument (vlax-get-acad-object))
Space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-Modelspace AcDoc)
      )
 )
 (prompt "\nSélectionnez les polylignes à fusionner: ")
 (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
   (progn
     (vla-StartUndoMark AcDoc)
     (setq
lst (mapcar 'vlax-ename->vla-object
	    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
reg (vl-catch-all-apply
      'vlax-invoke
      (list Space 'addRegion lst)
    )
     )
     (if (vl-catch-all-error-p reg)
(princ (vl-catch-all-error-message reg))
(progn
  (while (cadr reg)
    (vla-boolean
      (car reg)
      acUnion
      (cadr reg)
    )
    (setq reg (cons (car reg) (cddr reg)))
  )
  (region2pline (vlax-vla-object->ename (car reg)))
  (vla-Highlight (vlax-ename->vla-object (entlast)) :vlax-true)
)
     )
     (vla-EndUndoMark AcDoc)
   )
 )
 (princ)
)


(defun region2pline (ent / ec os ss n lst)
 (setq echo (getvar "CMDECHO"))
 (setq os (getvar "OSMODE"))
 (setvar "CMDECHO" 0)
 (setvar "OSMODE" 0)
 (command "_.explode" ent)
 (setq ss (ssget "_p"))
 (repeat (setq n (sslength ss))
   (setq lst (cons (ssname ss (setq n (1- n))) lst))
 )
 (if (vl-every	'(lambda (x)
	   (or (= (cdr (assoc 0 (entget x))) "LINE")
	       (= (cdr (assoc 0 (entget x))) "ARC")
	   )
	 )
	lst
     )
   (progn
     (command "_.ucs" "_save" "scu_init")
     (command "_.ucs"
       "_zaxis"
       '(0 0 0)
       (cdr (assoc 210 (entget (ssname ss 0))))
     )
     (if (= (getvar "PEDITACCEPT") 1)
(command "_.pedit" (ssname ss 0) "_join" ss "" "")
(command "_.pedit" (ssname ss 0) "_yes" "_join" ss "" "")
     )
     (command "_.ucs" "_restore" "scu_init")
     (command "_.ucs" "_delete" "scu_init")
   )
 )
 (setvar "CMDECHO" echo)
 (setvar "OSMODE" os)
) 

[lecrabe]

 

Bonsoir Fab et Gilles

 

Mille Mercis à Gilles pour sa super routine FUSION ! :)

 

Ca marche nickel-chrome-vanadium !! :D

 

Gilles, ta rapidité et efficacité m'impressionnent toujours !!! :cool:

 

Le Decapode "humble devant un Dieu du Lisp & V-Lisp"

 

[(gile)]

Une version mieux aboutie.

 

Si parmi les ploylignes sélectionnées, une ou plusieurs n'étaient pas contiguës la routine échouait.

Cette nouvelle version crée une polyligne sur le contour chaque groupe de polylignes contigues sélectionnées, il est donc possible de sélectionner plusieurs "lots" en une seule fois.

Le LISP fonctionne quelque soient le SCU courant et le SCU de création des polylignes sélectionnées.

 

 

;;; FUSION -Gilles Chanteau- 01/01/06
;;; Crée une polyligne sur le contour de chaque gorupe de polylignes fermées et contiguës sélectionnées.

(defun c:fusion	(/ gile_vl_err	     join-pline	       arcbulge
	   AcDoc    Space    ss	      lst      reg
	   Norm	    expl     objs     regs     olst
	   blst	    plst     dlst     tlst     blg
	   pline
	  )
 (vl-load-com)

;;;***************************************************************;;;

 (defun gile_vl_err (msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

;;;***************************************************************;;;

 (defun arcbulge (arc)
   (/ (sin (/ (vla-get-TotalAngle arc) 4))
      (cos (/ (vla-get-TotalAngle arc) 4))
   )
 )

;;;***************************************************************;;;

 (setq	AcDoc	(vla-get-activeDocument (vlax-get-acad-object))
Space	(if (= 1 (getvar "CVPORT"))
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-Modelspace AcDoc)
	)
m:err	*error*
*error*	gile_vl_err
 )
 (prompt "\nSélectionnez les polylignes à fusionner: ")
 (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
   (progn
     (vla-StartUndoMark AcDoc)
     (if (setq	reg
	 (vlax-invoke
	   Space
	   'addRegion
	   (mapcar 'vlax-ename->vla-object
		   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	   )
	 )
  )
(progn
  (while (cadr reg)
    (vla-boolean
      (car reg)
      acUnion
      (cadr reg)
    )
    (setq reg (cons (car reg) (cddr reg)))
  )
  (setq	reg  (car reg)
	Norm (vlax-get reg 'Normal)
	expl (vlax-invoke reg 'Explode)
  )
  (vla-delete reg)
  (while expl
  (setq	objs (vl-remove-if-not
	       '(lambda	(x)
		  (or
		    (= (vla-get-ObjectName x) "AcDbLine")
		    (= (vla-get-ObjectName x) "AcDbArc")
		  )
		)
	       expl
	     )
	regs (vl-remove-if-not
	       '(lambda (x) (= (vla-get-ObjectName x) "AcDbRegion"))
	       expl
	     )
  )
  (if objs
    (progn
      (setq olst (mapcar '(lambda (x)
			    (list x
				  (vlax-get x 'StartPoint)
				  (vlax-get x 'EndPoint)
			    )
			  )
			 objs
		 )
      )
      (while olst
	(setq blst nil)
	(if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
	  (setq blst (list (cons 0 (arcbulge (caar olst)))))
	)
	(setq plst (cdar olst)
	      dlst (list (caar olst))
	      olst (cdr olst)
	)
	(while
	  (setq
	    tlst (vl-member-if
		   '(lambda (x)
		      (or (equal (last plst) (cadr x) 1e-9)
			  (equal (last plst) (caddr x) 1e-9)
		      )
		    )
		   olst
		 )
	  )
	   (if (equal (last plst) (caddar tlst) 1e-9)
	     (setq blg -1)
	     (setq blg 1)
	   )
	   (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
	     (setq
	       blst (cons (cons	(1- (length plst))
				(* blg (arcbulge (caar tlst)))
			  )
			  blst
		    )
	     )
	   )
	   (setq plst (append plst
			      (if (minusp blg)
				(list (cadar tlst))
				(list (caddar tlst))
			      )
		      )
		 dlst (cons (caar tlst) dlst)
		 olst (vl-remove (car tlst) olst)
	   )
	)
	(setq pline
	       (vlax-invoke
		 Space
		 'addLightWeightPolyline
		 (apply	'append
			(mapcar	'(lambda (x)
				   (setq x (trans x 0 Norm))
				   (list (car x) (cadr x))
				 )
				(reverse (cdr (reverse plst)))
			)
		 )
	       )
	)
	(vla-put-Closed pline :vlax-true)
	(mapcar
	  '(lambda (x) (vla-setBulge pline (car x) (cdr x)))
	  blst
	)
	(vla-put-Elevation
	  pline
	  (caddr (trans (car plst) 0 Norm))
	)
	(vla-put-Normal pline (vlax-3d-point Norm))
               (vla-Highlight pline :vlax-true)
	(mapcar 'vla-delete dlst)
      )
    )
  )
  (if regs
    (progn
      (setq
	expl (append (vlax-invoke (car regs) 'Explode)
		     (cdr regs)
	     )
      )
      (vla-delete (car regs))
    )
    (setq expl nil)
  )
)
)
     )
     (vla-EndUndoMark AcDoc)
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

[Edité le 23/12/2006 par (gile)]

 

[Edité le 1/1/2007 par (gile)]

[Gilson]

bon d'accord. mais concrètement si je veux fusionner mes 4 polylignes pour en faire un rectangle par exemple je dois taper tout ce texte ou il ya un moyen d'y aller plus vite ?

[(gile)]

Bonjour...

 

pour l'utilisation de routine LISP (comme celle -ci dessus) voir cette page

 

Au revoir et merci...

[lili2006]

Bonsoir à toutes et tous,

 

Tip top ! :D

 

Merci Gilles,

 

PS: Je crois que tu as "raté" ton lien, ;)