closed polyline between two polylines

[Tomislav]

I have just one question, can someone look at that my lisp and help me why I'm not getting left_xcross and right_xcross correctly?

[devitg]

Please upload YOUR lisp .

 

[Tomislav]

(defun c:ABP (/ pline_top pline_bottom top_pts bottom_pts top_right top_left obj_top obj_bottom)


  (defun *error* (emsg)
    (if (or (= emsg "quit / exit abort")
            (= emsg "bad argument type: lselsetp nil")
        ) ;_  or
      (princ)
      (princ emsg)
    ) ;_  if
    (setvar 'OSMODE osm)
    (setvar 'CMDECHO cmd)
    (gc)
  ) ;_  defun

 

  (setq cmd (getvar 'CMDECHO)
        osm (getvar 'OSMODE)
  ) ;_  setq
  (setvar 'OSMODE 0)
  (setq pline_top nil
        pline_bottom nil
        top_pts nil
        bottom_pts nil
        top_right nil
        top_left nil
        bottom_left nil
        bottom_right nil
        obj_top nil
        obj_bottom nil)
  (vl-load-com)
  (setq pline_top (entsel "\nSelect the top polyline: "))
  (setq pline_bottom (entsel "\nSelect the bottom polyline: "))
  ;; read all vertices
  (setq top_pts
         (vl-sort
            (polyverts (car pline_top));  sortirano od lijeva na desno
           (function
             (lambda (x1 x2) (< (car x1) (car x2))) ;_ _ lambda
           ) ;_ _ function
         ) ;_ _ vl-sort
  ) ;_  setq
  (setq bottom_pts
         (vl-sort
           (polyverts (car pline_bottom)) ;  sortirano od lijeva na desno
           (function
             (lambda (x1 x2) (< (car x1) (car x2))) ;_ _ lambda
           ) ;_ _ function
         ) ;_ _ vl-sort
  ) ;_  setq

  ;; get last vertices on left and right
  (setq bottom_left (car bottom_pts))
  (setq bottom_right (last bottom_pts))
  (setq top_left (car top_pts))
  (setq top_right (last top_pts))
  (setq vla_pline_top (vlax-ename->vla-object (car pline_top)))
  (setq vla_pline_bottom (vlax-ename->vla-object (car pline_bottom)))
  
  (if (< (car top_right) (car bottom_right))
    (progn
      (setq right_xline(xLine top_right (list 0.0 1.0 0.0)))
      ;(setq right_xline (entlast))
      (setq maxx_right(car top_right)
            tr T
      ) ;_  setq
      (setq right_xcross (getIntersection (vlax-ename->vla-object right_xline)vla_pline_bottom)
            )
    ) ;_  progn
    (progn
      (setq right_xline(xLine bottom_right (list 0.0 1.0 0.0)))
      ;(setq right_xline (entlast))
      (setq maxx_right(car bottom_right)
            br T
      ) ;_  setq
      (setq right_xcross (getIntersection (vlax-ename->vla-object right_xline)vla_pline_top)
            )
    ) ;_  progn
  ) ;_  if
 
  (if (> (car top_left) (car bottom_left))
    (progn
      (setq left_xline(xLine top_left (list 0.0 1.0 0.0)))
      ;(setq left_xline (entlast))
      (setq maxx_left(car top_left)
            tl T
      ) ;_  setq
      (setq left_xcross (getIntersection (vlax-ename->vla-object left_xline)vla_pline_bottom)
            )
                          
    ) ;_  progn
    (progn
      (setq left_xline(xLine bottom_left (list 0.0 1.0 0.0)))
      ;(setq left_xline (entlast))
      (setq maxx_left(car bottom_left)
            bl T
      ) ;_  setq
      (setq left_xcross (getIntersection (vlax-ename->vla-object left_xline)vla_pline_top)
            )
    ) ;_  progn
  ) ;_  if


  (princ"\n")
  (princ right_xcross)
  (princ"\n")
  (princ left_xcross)
  (vl-cmdf "point" top_right)
  (vl-cmdf "point" top_left)

) ;_  defun




 ;; returns the vertices of a polyline.
 (defun vertices_xsorted (ent / vertex_lst)
   (setq vertex_lst nil)
   (foreach
          dp ent
     (if (= (car dp) 10)
       (setq vertex_lst (append vertex_lst (list (cdr dp))))
     ) ;_  if
   ) ;_  foreach
   ;; sorted from left to right
   (setq vertex_lst ; 
          (vl-sort
            vertex_lst
            (function
              (lambda (x1 x2) (< (car x1) (car x2))) ;_ _ lambda
            ) ;_ _ function
          ) ;_ _ vl-sort
   ) ;_ _ setq
 ) ;_  defun


  ;; draw xline
  (defun xLine (pt vec)
    (entmakex
      (list (cons 0 "XLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbXline")
            (cons 10 pt)
            (cons 11 vec)
      ) ;_  list
    ) ;_  entmakex
  ) ;_  defun



;; Retrieve Polyline Vertices  -  Lee Mac
;; ent - [ent] Entity name of LWPolyline or Polyline

(defun polyverts (ent / _lwpolyverts _polyverts)

  (defun _lwpolyverts (enx / itm)
    (if	(setq itm (assoc 10 enx))
      (cons (cdr itm) (_lwpolyverts (cdr (member itm enx))))
    ) ;_ if
  ) ;_ defun
  (defun _polyverts (ent / enx)
    (if	(= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
      (cons (cdr (assoc 10 enx)) (_polyverts (entnext ent)))
    ) ;_ if
  ) ;_ defun
  (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
    (_lwpolyverts (entget ent))
    (_polyverts (entnext ent))
  ) ;_ if
) ;_ defun


  ;; interesection of two line objects
  (defun getIntersection (obj1 obj2 / intersection)    
    (setq gr3 (vlax-invoke  obj1 'IntersectWith  obj2 acExtendNone))
    (repeat (/ (length gr3) 3)
    (setq intlst (cons (list (car gr3) (cadr gr3) (caddr gr3)) intlst)
	  gr3 (cdddr gr3)
	  ) ;_  setq
    ) ;_  repeat
    (setq intersection(car(reverse intlst)))
    )

(princ "\nArea between polylines...by Tomislav Vargek...type ABP to initiate!")


;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;

it's already uploaded on first page, but here it is again 

[devitg]

Please show at which polynes pair it do not work.

 

It works at this pair , the first from top to bottom at your DWG 

 

 

 

[devitg]

also work for the 2nd  pair 

 

[devitg]

also work for the 3th    pair 

[devitg]

I tested  all pairs , and it work good,

 

[Tomislav]

if you look at the code, you'll see it is supposed to write coordinates of intersection points between xlines and longer part of opposing polyline, they are named right_xcross and left_xcross...I nedd that to continue work on my lisp

Edited September 30, 2020 by Tomislav

[BIGAL]

Like devitg did you run my code ? Works on all 2 pline combos I tried.

 

It has pts if that is what you want. Pt1 pt2

 

Are you changing your request now ?

[Tomislav]

17 hours ago, devitg said:

 

 

 

7 hours ago, BIGAL said:

Like devitg did you run my code ? Works on all 2 pline combos I tried.

 

It has pts if that is what you want. Pt1 pt2

 

Are you changing your request now ?

 

Your lisp works, but just draws one line on one end and doesn't create boundary most of time...(have you downloaded my example.dwg?)

And no, I'm not changing my request, dlanorh had made lisp that finished my request.

I just want to finish my own lisp so I can learn...

Edited October 1, 2020 by Tomislav

[Tomislav]

found the bug...intersection function...

[BIGAL]

I checked against your dwg and made a couple of changes to code increased the offset point from 0.1 did not want to work, should work for any combo. Must pick 2 points at each end twice. If you want co-ords of points can get via (entlast)

[Tomislav]

5 hours ago, BIGAL said:

I checked against your dwg and made a couple of changes to code increased the offset point from 0.1 did not want to work, should work for any combo. Must pick 2 points at each end twice. If you want co-ords of points can get via (entlast)

where did you make changes?

[BIGAL]

Added pickpt1 & pickpt2 changed offset to 10 for pt3 as 0.1 was not working. Needs to be as small as possible. Depends on your dwg, can do some size checks so value is relevant need more samples for testing.

[Tomislav]

Ok guys, I've finished my version if anyone needs it.

The difference with my version is that it works if there are other parts of the drawing crossing selected polylines...

 

 

(defun c:ABP (/ pline_first pline_second first_pts second_pts first_right first_left obj_top obj_bottom)


  (defun *error* (emsg)
    (if (or (= emsg "quit / exit abort")
            (= emsg "bad argument type: lselsetp nil")
        ) ;_  or
      (princ)
      (princ emsg)
    ) ;_  if
    (setvar 'OSMODE osm)
    (setvar 'CMDECHO cmd)
    (gc)
  ) ;_  defun



  (setq cmd (getvar 'CMDECHO)
        osm (getvar 'OSMODE)
  ) ;_  setq
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)  
  (setq pline_first    nil
        pline_second nil
        first_pts      nil
        second_pts   nil
        first_right    nil
        first_left     nil
        second_left  nil
        second_right nil
        tl nil
        tr nil
        bl nil
        br nil
  ) ;_  setq
  (vl-load-com)
  (setq pline_first (entsel "\nSelect first polyline: "))
  (setq pline_second (entsel "\nSelect second polyline: "))
  ;; read all vertices
  (setq first_pts
         (vl-sort
           (polyverts (car pline_first)) ;  sorted from left to right
           (function
             (lambda (x1 x2) (< (car x1) (car x2))) ;_ _ lambda
           ) ;_ _ function
         ) ;_ _ vl-sort
  ) ;_  setq
  (setq second_pts
         (vl-sort
           (polyverts (car pline_second)) ;  sorted from left to right
           (function
             (lambda (x1 x2) (< (car x1) (car x2))) ;_ _ lambda
           ) ;_ _ function
         ) ;_ _ vl-sort
  ) ;_  setq

  ;; get last vertices on left and right
  (setq second_left (car second_pts))
  (setq second_right (last second_pts))
  (setq first_left (car first_pts))
  (setq first_right (last first_pts))
  (setq vla_pline_first (vlax-ename->vla-object (car pline_first)))
  (setq vla_pline_second (vlax-ename->vla-object (car pline_second)))

  (if (< (car first_right) (car second_right))
    (progn
      (setq right_xline (xLine first_right (list 0.0 1.0 0.0)))
      (setq maxx_right(car first_right)
            tr T
      ) ;_  setq
      (setq right_xcross
             (getIntersection
               (vlax-ename->vla-object right_xline)
               vla_pline_second
             ) ;_  getIntersection
      ) ;_  setq
    ) ;_  progn
    (progn
      (setq right_xline (xLine second_right (list 0.0 1.0 0.0)))
      (setq maxx_right(car second_right)
            br T
      ) ;_  setq
      (setq right_xcross
             (getIntersection (vlax-ename->vla-object right_xline) vla_pline_first)
      ) ;_  setq
    ) ;_  progn
  ) ;_  if
  (entdel(entlast))

  ;; get crossings between polylines and xlines
  (if (> (car first_left) (car second_left))
    (progn
      (setq left_xline (xLine first_left (list 0.0 1.0 0.0)))
      (setq maxx_left (car first_left)
            tl T
      ) ;_  setq
      (setq left_xcross
             (getIntersection (vlax-ename->vla-object left_xline) vla_pline_second)
      ) ;_  setq
    ) ;_  progn
    (progn
      (setq left_xline (xLine second_left (list 0.0 1.0 0.0)))
      (setq maxx_left (car second_left)
            bl T
      ) ;_  setq
      (setq left_xcross
             (getIntersection (vlax-ename->vla-object left_xline) vla_pline_first)
      ) ;_  setq
    ) ;_  progn
  ) ;_  if
  
  (entdel(entlast))

  ;; adapt lists of vertices for new polyline
  (setq first_pts(removeVertices first_pts maxx_left maxx_right))
  (setq second_pts(removeVertices second_pts maxx_left maxx_right))
  (if tl
    (setq second_pts (reverse(append (reverse second_pts) (list left_xcross))))
    )
  (if tr
    (setq second_pts (append second_pts (list right_xcross)))
    )
  (if bl
    (setq first_pts (reverse(append (reverse first_pts) (list left_xcross))))
    )
  (if br
    (setq first_pts (append first_pts (list right_xcross)))
    )

  
  (LWPoly(append first_pts (reverse second_pts))1)


  (setvar 'OSMODE osm)
  (setvar 'CMDECHO cmd)
) ;_  defun


(princ "\nArea between polylines...by Tomislav Vargek...type ABP to initiate!")


  
;; remove unnecessary vertices left and right
(defun removeVertices (ent_pts maxx_left maxx_right)
  (setq ent_pts
         (vl-remove-if
           (function
             (lambda (x)
               (< (car x) maxx_left)
             ) ;_  lambda
           ) ;_  function
           ent_pts
         ) ;_  vl-remove-if
  ) ;_  setq
    (setq ent_pts
         (vl-remove-if
           (function
             (lambda (x)
               (> (car x) maxx_right)
             ) ;_  lambda
           ) ;_  function
           ent_pts
         ) ;_  vl-remove-if
  ) ;_  setq
) ;_  defun



;; draw xline
(defun xLine (pt vec)
  (entmakex
    (list (cons 0 "XLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbXline")
          (cons 10 pt)
          (cons 11 vec)
    ) ;_  list
  ) ;_  entmakex
) ;_  defun



;; Retrieve Polyline Vertices  -  Lee Mac
;; ent - [ent] Entity name of LWPolyline or Polyline

(defun polyverts (ent / _lwpolyverts _polyverts)

  (defun _lwpolyverts (enx / itm)
    (if (setq itm (assoc 10 enx))
      (cons (cdr itm) (_lwpolyverts (cdr (member itm enx))))
    ) ;_ if
  ) ;_ defun
  (defun _polyverts (ent / enx)
    (if (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
      (cons (cdr (assoc 10 enx)) (_polyverts (entnext ent)))
    ) ;_ if
  ) ;_ defun
  (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
    (_lwpolyverts (entget ent))
    (_polyverts (entnext ent))
  ) ;_ if
) ;_ defun


;; LM's entmake functions
(defun LWPoly (lst closed); 0-open, 1-closed
 (entmakex 
   (append 
     (list 
       (cons 0 "LWPOLYLINE")
       (cons 100 "AcDbEntity")
       (cons 100 "AcDbPolyline")
       (cons 90 (length lst))
       (cons 70 closed)
     )
     (mapcar (function (lambda (p) (cons 10 p))) lst)
   )
 )
)


;; interesection of two line objects
(defun getIntersection (obj1 obj2 / gr3 intlst)
  (setq gr3 (vlax-invoke obj1 'IntersectWith obj2 acExtendNone))
  (repeat (/ (length gr3) 3)
    (setq intlst (cons (list (car gr3) (cadr gr3) (caddr gr3)) intlst)
          gr3    (cdddr gr3)
    ) ;_  setq
  ) ;_  repeat
  (car intlst)
) ;_  defun


;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;