how to Merge closed polylines

[handasa]

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

 

[ReMark]

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?

[handasa]

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

[ReMark]

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.

[handasa]

iam here to find this way .. thanks , ReMark

[Grrr]

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
)

Edited October 23, 2017 by Grrr

[handasa]

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

[ronjonp]

Convert all items to regions then use the union command.

[David Bethel]

Convert all items to regions then use the union command.

 

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

[Stefan BMR]

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.

[ronjonp]

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

 

Sometimes it's just too easy

[handasa]

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

[exceed]

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