Help with lisp - join polylines external/internal

Help with lisp - join polylines external/internal

yu85.info
Collaborator Collaborator
1,068 Views
6 Replies
Message 1 of 7

Help with lisp - join polylines external/internal

yu85.info
Collaborator
Collaborator

Hi, I would be happy if someone can help me with a simple lisp.

I have polylines and lines in DWG - A (attached) I need to convert all the internal lines into closed polylines  in layer "internal" and  the external polyline to a closed one in layer "external". If there is an open polyline it will be in layer - "open".  so the result will be DWG -B (attached). 

Thank you so much in advance 

0 Likes
Accepted solutions (1)
1,069 Views
6 Replies
Replies (6)
Message 2 of 7

Rick_Tolleshaug_TSC
Advocate
Advocate

When you say "help with a simple lisp"...have you made attempts to write it yourself, something you could share? Or are you needing someone to write the entire routine?

0 Likes
Message 3 of 7

Moshe-A
Mentor
Mentor
Accepted solution

@yu85.info hi,

 

Check this IEP (Internal \ External Polyline) command.

explain what these polylines represent?

 

enjoy

Moshe

 

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
); LM:intersections


; Internal External Polylines

(defun c:IEP (/ _clwp _areas _midpt _3d->2d _isexist  ; local function
	        ss1 ss2 ss3 ss4 ename data^ exAcDbPline inAcDbPline item AcDbRegion AcDbRay c0 c1 ang o1 o2 area lst)

 (defun _clwp (ename / elist)
  (setq elist (entget ename))
  (cond
   ((= (logand (cdr (assoc '70 elist)) 1) 1) ; closed pline
    t
   ); case
   ((and
      (= (logand (cdr (assoc '70 elist)) 0) 0) ; open pline
      (equal (distance (vlax-curve-getEndPoint ename) (vlax-curve-getStartPoint ename)) 0.0 1e-3)
    )
    (command "._pedit" ename "_close" "")
    t
   ); case
  ); cond
 ); _clwp
  
 (defun _areas (ss0)
  (vl-sort
   (vl-remove-if
     'not
     (mapcar
       (function
         (lambda (ename / area)
	   (if (> (setq area (vlax-curve-getArea ename)) 0.0)
	    (cons (vlax-curve-getArea ename) ename)
	   )
         ); lambda
       ); function
       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
     ); mapcar
   ); vl-remove-if
   (function (lambda (e0 e1) (> (car e0) (car e1))))
  ); vl-sort
 ); _areas

 (setq _midpt (lambda (p0 p1) (mapcar (function (lambda (x0 x1) (/ (+ x0 x1) 2))) p0 p1)))
 (setq _3d->2d (lambda (pt) (reverse (cdr (reverse pt)))))
 (setq _isexist (lambda (a l) (vl-some (function (lambda (itm) (= a (car itm)))) l)))

  
 ; here start c:iep
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
 
 (if (setq ss1 (ssget '((0 . "line,polyline,lwpolyline"))))
  (progn
   (setq ss2 (ssadd) ss3 (ssadd) ss4 (ssadd))
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
    (if (eq (cdr (assoc '0 (entget ename))) "LINE")
     (ssadd ename ss4)
     (cond
      ((_clwp ename)
       (ssadd ename ss2)
      ); case
      ((> (vlax-curve-getArea ename) 0.0)
       (ssadd ename ss3)
      ); case
      ( t
       (ssadd ename ss4)
      ); case
     ); cond
    ); if
   ); foreach

   (command "._layer" "_new" "open" "_color" 2 "open" "_off" "open" "")
   (command "._chprop" "_si" ss3 "_layer" "open" "")

   (setq data^ (_areas ss2))
   (setq exAcDbPline (vlax-ename->vla-object (cdar data^)))

   (command "._layer" "_new" "external" "_color" 1 "external" "")
   (command "._chprop" "_si" (cdar data^) "_layer" "external" "")
   (ssdel (cdar data^) ss2)

   (foreach item (cdr data^)
    (setq inAcDbPline (vlax-ename->vla-object (cdr item)))

    (command "._copy" "_si" (cdr item) "0,0,0" "0,0,0")
    (command "._region" "_si" (entlast))
    (setq AcDbRegion (vlax-ename->vla-object (entlast)))
    (setq c0 (vlax-safearray->list (vlax-variant-value (vla-get-centroid AcDbRegion))))
    (vla-delete AcDbRegion)
    (vlax-release-object AcDbRegion)

    (setq ang 0.0)
    (repeat 4
     (command "._ray" "_None" c0 "_None" (polar c0 ang 1.0) "")
     (setq AcDbRay (vlax-ename->vla-object (entlast)))

     (if (and
	  (setq o1 (LM:intersections inAcDbPline AcDbRay acExtendNone))
	  (= (vl-list-length o1) 1)
          (setq o2 (LM:intersections exAcDbPline AcDbRay acExtendNone))
	  (= (vl-list-length o2) 1)
	 )
      (progn
       (vla-delete AcDbRay)
       (command "._boundary" "_None" (setq c1 (_3d->2d (_midpt (car o1) (car o2)))) "")
       (setq area (vlax-curve-getArea (entlast)))

       (if (not (_isexist area lst))
        (setq lst (cons (list area c1) lst))
       )

       (entdel (entlast)) ; delete boundary
      ); progn
      (vla-delete AcDbRay)
     ); if
      
     (setq ang (+ ang (/ pi 2)))
     (vlax-release-object AcDbRay)
    ); repeat
     
    (vlax-release-object inAcDbPline) 
   ); foreach

   (vlax-release-object exAcDbPline)

   (command "._layer" "_new" "internal" "_color" 6 "internal" "")
   (command "._chprop" "_si" ss2 "_layer" "internal" "")

   ; draw polylines
   (foreach item lst
    (command "._boundary" "_None" (cadr item) "")
    (command "._chprop" "_si" "_Last" "_layer" "internal" "")
    (command "._draworder" "_si" "_Last" "_Front")    
   ); foreach

   (command "._layer" "_on" "open" "")
   (command "._erase" "_si" ss4)
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); c:iep

 

Message 4 of 7

yu85.info
Collaborator
Collaborator

Thanks @Moshe-A !

You've done it again.

amazing

0 Likes
Message 5 of 7

Moshe-A
Mentor
Mentor

Yuval hi,

 

thank you for that 💪

i still would like to know what these plines represent?

 

Moshe

 

Message 6 of 7

yu85.info
Collaborator
Collaborator

The DWG I attached was just a sketch. The main purpose is converting 3D polylines from field survey into polygons in order to use them in GIS. 

0 Likes
Message 7 of 7

yu85.info
Collaborator
Collaborator

@Moshe-A Is there a way please to modify the lisp  for 3D polylines?

So I can go from A to B like in the DWG file "C" I attached

0 Likes