how to Merge closed polylines

Greetings Everyone

i need to know how to do that via lisp

a selection set of 3 closed polylines to 1 merged polyline

these closed polylines may have arcs , bulges or circular segments

thanks and best regards

It looks more like you are just creating a border around them not merging them. Have you looked at Lee Mac's Outline Objects lisp routine?

Lee Mac's Outline Objects lisp work only with the intersected polylines and leave the inside polyline as is

Then you are two thirds of the way there aren't you? Find a way to delete the orphan and you are good to go.

iam here to find this way .. thanks , ReMark

I guess like this:

(defun C:test ( / *error* acDoc oSS SS i e o ll ur d eL r )
 
 (defun *error* ( m )
   (and acDoc (vla-EndUndoMark acDoc))
   (and m (princ m)) (princ)
 ); defun *error*
 
 (cond
   ( (not LM:outline) (alert "\n\"LM:outline\" is not loaded, please load it and call this routine again.") )
   (
     (progn 
       (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
       (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
       (alert "\nSelect a SINGLE Island to outline, only the largest one will be retained.")
     )
   )
   ( (not (setq oSS (ssget "_:L-I"))) )
   ( (setq SS (LM:outline oSS))
     (and 
       (progn (initget "Yes No") (= "Yes" (cond ((getkword "\nErase original objects? [Yes/No] <Yes>: ")) ("Yes"))))
       (repeat (setq i (sslength oSS)) (entdel (ssname oSS (setq i (1- i)))) )
     ); and
     (repeat (setq i (sslength SS))
       (and
         (setq o (vlax-ename->vla-object (setq e (ssname SS (setq i (1- i))))))
         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list o 'll 'ur)))) ; RAY, XLINE
         (setq d (apply 'distance (mapcar 'vlax-safearray->list (list ll ur))))
         (if r 
           (or (and (< (car r) d) (setq eL (cons (cadr r) eL)) (setq r (list d e)) ) (setq eL (cons e eL)) )
           (setq r (list d e))
         ); if r
       ); and
     ); repeat
     (mapcar 'entdel eL)
   )
 ); cond
 (vla-EndUndoMark acDoc) (princ)
); defun

Use it only for a single set of intersecting objects (don't select multiple islands).

EDIT:

This subfunction may be of interest:

; http://www.cadtutor.net/forum/showthread.php?100467-Find-the-highest-and-lowest-mark-from-the-selected-quot-points-quot
; _$ (extremum '< '(3 8 9 1 5 6 2 7)) -> 1
; _$ (extremum '(lambda ( a b ) (< (caddr a) (caddr b))) '((1.2 5.7 8.3) (9.4 2.6 0.3) (5.7 6.6 7.2))) -> (9.4 2.6 0.3)
(defun extremum ( cmp lst / rtn ) 
 ;; Lee Mac 
 (setq rtn (car lst))
 (foreach itm (cdr lst)
   (if (apply cmp (list itm rtn)) (setq rtn itm))
 )
 rtn
)

thanks , Grrr this worked for one set of intersections ... but i have multiple sets of intersections .. i will try to find a way to handle that

Convert all items to regions then use the union command.

Convert all items to regions then use the union command.

Wow ! 1 of the best uses a 3DSOLIDs I've seen ! -David

Greetings Everyone

i need to know how to do that via lisp

 

a selection set of 3 closed polylines to 1 merged polyline

 

these closed polylines may have arcs , bulges or circular segments

 

 

thanks and best regards

The problem was solved many times.

I guess you saw at least one of them.

Here is my version.

Wow ! 1 of the best uses a 3DSOLIDs I've seen ! -David

Sometimes it's just too easy

The problem was solved many times.

I guess you saw at least one of them.

 

Here is my version.

thanks , Stef ... that's worked like a charm

(defun c:recunion ( / ss n k fe ss2 ss3 en )
   (setvar 'CMDECHO 0)
   (setq ss (ssget ":L")) (terpri)
   (setq n (sslength ss))
   (setq k 0)
   (setq ss2 (ssadd))
   (while (<= 1 n)
            (setq en (ssname ss k))
	(command "region" en "")
	(setq fe (entlast))
            (ssadd fe ss2)
            (setq n (- n 1))
            (setq k (+ k 1))
   )
  (command "union" ss2 "")
  (setq ss3 (ssget "_P" '((0 . "REGION"))))
  (:Region2Polyline ss3)
  (setvar 'CMDECHO 1)
(princ)
); end of defun


(defun c:revunion ( / ss n k fe ss2 ss3 en )
   (setvar 'CMDECHO 0)
   (setq ss (ssget ":L")) (terpri)
   (setq n (sslength ss))
   (setq k 0)
   (setq ss2 (ssadd))
   (while (<= 1 n)
            (setq en (ssname ss k))
	(command "region" en "")
	(setq fe (entlast))
            (ssadd fe ss2)
            (setq n (- n 1))
            (setq k (+ k 1))
   )
  (command "union" ss2 "")
  (setq ss3 (ssget "_P" '((0 . "REGION"))))
  (:Region2Polyline ss3)

  (command "revcloud" "s" "n" "o" (entlast) "n" )

  (setvar 'CMDECHO 1)
(princ)
); end of defun




(defun c:Region2Polyline nil
  (if (setq ss (ssget '((0 . "REGION"))))
    (:Region2Polyline ss))
  (princ)
  )

;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline (ss / *error* arcbugle acdoc space
			 n reg norm expl olst blst dlst plst tlst blg pline)
  
  ;-----
  (defun *error* (msg)
    (if	(/= msg "Function cancelled")
      (princ (strcat "\nError: " msg)))
    (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    (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)))
  (if ss
    (repeat (setq i (sslength ss))
      (setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
	    norm (vlax-get reg 'Normal)
	    expl (vlax-invoke reg 'Explode))
      (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
				     (= (vla-get-ObjectName x) "AcDbArc")))
		    expl)
	(progn
	  (vla-delete reg)
	  (setq olst (mapcar '(lambda	(x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
			     expl))
	  (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))
	    (mapcar 'vla-delete dlst)))
	(mapcar 'vla-delete expl)))
    )
  )
  
 (defun c:revmi ()
  (if (setq ss (ssget))
    (command "revcloud" "s" "n" "o" ss))
  (princ)
) 
  
  
  

use gilles chanteau's :Region2Polyline

RECUNION : merge any closed polyline, circle also

REVUNION : RECUNION + REVCLOUD

REVMI : REVCLOUD mirror (for REVUNION unintended direction)