closed polyline between two polylines

[Tomislav]

Hello everyone.

I tried to do it but simply don't have the knowledge to make it. I'm in need of lisp where I select two polylines and the lisp creates closed polyline on current layer, using those selected and leaving them in drawing.

Now the trick is on each side the shorter polyline must cut the longer one or connects to longer one using ortho (it's not perpendicular).

And another problem is that there are other lines and polylines crossing those two (cross section).

See the image for better understanding.

Edited September 26, 2020 by Tomislav
added text

[devitg]

For better understanding, and  maybe get further help, please upload such sample.dwg

[BIGAL]

If happy a single go at a time is relatively easy trying to automate 2 plines adding which is shorter complicates.

 

1  Pick pline 1 near end getting end point

2  Pick pline 2 

3  draw line 

4  repeat other end steps 1 2 3

5  Bpoly

6  erase  dummy end lines

 

7 repeat 1-6 above for as many as required.

 

Is a choice Vertical or Horizontal, or only Vertical is that required ?

Edited September 27, 2020 by BIGAL

[Tomislav]

16 hours ago, devitg said:

For better understanding, and  maybe get further help, please upload such sample.dwg

here it is my friend..

sample.dwg

[hosneyalaa]

 

This LISP is suitable
But it needs to be modified

 

 

;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/intersection-point-list/td-p/2065100
;; find insert points
(defun intpoints (obj1 obj2 / result intvar pt)
    (vl-load-com)
    (if (and obj1 obj2)
        (progn
            (setq intvar (vlax-invoke obj1 'Intersectwith obj2 0))
            (while (caddr intvar)
                (setq pt (list (car intvar) (cadr intvar) (caddr intvar)))
                (setq result (cons pt result))
                (setq intvar (cdddr intvar))
            )
        )
        (princ "\nSelection error..")
    )
    (if result
        (reverse result)
    )
)


(defun Line (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
)))

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

;; returns the vertices of a polyline.
;; The left endpoint is returned first, so sometimes the points get returned reversed                   
(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))))
    )
  )
  ;; sort, maake sure the first point is on the left
  (if (< (nth 0 (nth 0 vertex_lst)) (nth 0 (last vertex_lst)) )
    vertex_lst
    (reverse vertex_lst)
  )
)

;; returns sorted x-values ...
(defun get_xvalues (top_pts bottom_pts minx maxx / pt xvalues)
  (setq xvalues (list))
  (foreach pt top_pts
    (if (and (<= (nth 0 pt) maxx) (>= (nth 0 pt) minx))
      (setq xvalues (append xvalues (list (nth 0 pt) )))
    )
  )
  (foreach pt bottom_pts
    (if (and (<= (nth 0 pt) maxx) (>= (nth 0 pt) minx))
      (setq xvalues (append xvalues (list (nth 0 pt) )))
    )
  )
  (vl-sort xvalues '<)
)


(defun c:ad ( / result pline1 pline2 top_pts bottom_pts minx maxx xvalues xlines x vlines i ins1 ins2 ins3 ins4 surfacesum)
  (setq pline1 (entsel "\nSelect the (green) top polyline: "))
  (setq pline2 (entsel "\nSelect the (blue) bottom polyline: "))

  ;; read all vertices
  (setq top_pts (vertices_xsorted (entget (car pline1))))
  (setq bottom_pts (vertices_xsorted (entget (car pline2))))
 
  ;; now collect all endpoints/vertices, both on the blue and green polyline
  ;; no need to get the vertices of the green polyline outside of the range of the blue polyline
  ;; we only need the x-value
  (setq minx (nth 0 (nth 0 bottom_pts)))
  (setq maxx (nth 0 (last bottom_pts)))

  (setq xvalues (get_xvalues top_pts bottom_pts minx maxx))
  ;; draw vertical xlines.  
  (setq xlines (list))
  (foreach x xvalues
    (setq xlines (append xlines (list
      (xLine (list x 0.0) (list 0.0 1.0 0.0))
    )))
  )
  ;; Now we have a series of trapeziums
  ;; sum the surfaces, divide by total horizontal distance
  (setq
    i 0
    surfacesum 0.0
  )
 
  (repeat (- (length xlines) 1)
    (setq ins1
      (intpoints
        (vlax-ename->vla-object (nth i xlines))
        (vlax-ename->vla-object (car pline1))
      )
    )
    (setq ins2
      (intpoints
        (vlax-ename->vla-object (nth i xlines))
        (vlax-ename->vla-object (car pline2))
      )
    )
    
    (setq ins3
      (intpoints
        (vlax-ename->vla-object (nth (+ i 1) xlines))
        (vlax-ename->vla-object (car pline1))
      )
    )
    (setq ins4
      (intpoints
        (vlax-ename->vla-object (nth (+ i 1) xlines))
        (vlax-ename->vla-object (car pline2))
      )
    )
    (setq surfacesum (+ surfacesum
      (*
        (+
          (distance (nth 0 ins1) (nth 0 ins2))                                                  ;; dist1
          (/ (- (distance (nth 0 ins3) (nth 0 ins4)) (distance (nth 0 ins1) (nth 0 ins2)) ) 2)  ;; (dist2 - dist1) / 2
        )
        (- (nth (+ i 1) xvalues ) (nth i xvalues))                                              ;; horizontal dist
      )
    ))
    
    (setq i (+ i 1))
  )
 
  ;; The result
  (setq result (/ surfacesum (- (last xvalues) (nth 0 xvalues))) )  
  ;; remove the X-lines
  (foreach x xlines
    (entdel x)
  )

  (princ "\nTotal surface: ")
  (princ surfacesum)
  (princ "\nAverage vertical distance: ")
  (princ result)
  (ALERT result)
  
 
  (princ)
)

 

[Tomislav]

5 hours ago, hosneyalaa said:

 

This LISP is suitable
But it needs to be modified

 

 

;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/intersection-point-list/td-p/2065100
;; find insert points
(defun intpoints (obj1 obj2 / result intvar pt)
    (vl-load-com)
    (if (and obj1 obj2)
        (progn
            (setq intvar (vlax-invoke obj1 'Intersectwith obj2 0))
            (while (caddr intvar)
                (setq pt (list (car intvar) (cadr intvar) (caddr intvar)))
                (setq result (cons pt result))
                (setq intvar (cdddr intvar))
            )
        )
        (princ "\nSelection error..")
    )
    (if result
        (reverse result)
    )
)


(defun Line (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
)))

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

;; returns the vertices of a polyline.
;; The left endpoint is returned first, so sometimes the points get returned reversed                   
(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))))
    )
  )
  ;; sort, maake sure the first point is on the left
  (if (< (nth 0 (nth 0 vertex_lst)) (nth 0 (last vertex_lst)) )
    vertex_lst
    (reverse vertex_lst)
  )
)

;; returns sorted x-values ...
(defun get_xvalues (top_pts bottom_pts minx maxx / pt xvalues)
  (setq xvalues (list))
  (foreach pt top_pts
    (if (and (<= (nth 0 pt) maxx) (>= (nth 0 pt) minx))
      (setq xvalues (append xvalues (list (nth 0 pt) )))
    )
  )
  (foreach pt bottom_pts
    (if (and (<= (nth 0 pt) maxx) (>= (nth 0 pt) minx))
      (setq xvalues (append xvalues (list (nth 0 pt) )))
    )
  )
  (vl-sort xvalues '<)
)


(defun c:ad ( / result pline1 pline2 top_pts bottom_pts minx maxx xvalues xlines x vlines i ins1 ins2 ins3 ins4 surfacesum)
  (setq pline1 (entsel "\nSelect the (green) top polyline: "))
  (setq pline2 (entsel "\nSelect the (blue) bottom polyline: "))

  ;; read all vertices
  (setq top_pts (vertices_xsorted (entget (car pline1))))
  (setq bottom_pts (vertices_xsorted (entget (car pline2))))
 
  ;; now collect all endpoints/vertices, both on the blue and green polyline
  ;; no need to get the vertices of the green polyline outside of the range of the blue polyline
  ;; we only need the x-value
  (setq minx (nth 0 (nth 0 bottom_pts)))
  (setq maxx (nth 0 (last bottom_pts)))

  (setq xvalues (get_xvalues top_pts bottom_pts minx maxx))
  ;; draw vertical xlines.  
  (setq xlines (list))
  (foreach x xvalues
    (setq xlines (append xlines (list
      (xLine (list x 0.0) (list 0.0 1.0 0.0))
    )))
  )
  ;; Now we have a series of trapeziums
  ;; sum the surfaces, divide by total horizontal distance
  (setq
    i 0
    surfacesum 0.0
  )
 
  (repeat (- (length xlines) 1)
    (setq ins1
      (intpoints
        (vlax-ename->vla-object (nth i xlines))
        (vlax-ename->vla-object (car pline1))
      )
    )
    (setq ins2
      (intpoints
        (vlax-ename->vla-object (nth i xlines))
        (vlax-ename->vla-object (car pline2))
      )
    )
    
    (setq ins3
      (intpoints
        (vlax-ename->vla-object (nth (+ i 1) xlines))
        (vlax-ename->vla-object (car pline1))
      )
    )
    (setq ins4
      (intpoints
        (vlax-ename->vla-object (nth (+ i 1) xlines))
        (vlax-ename->vla-object (car pline2))
      )
    )
    (setq surfacesum (+ surfacesum
      (*
        (+
          (distance (nth 0 ins1) (nth 0 ins2))                                                  ;; dist1
          (/ (- (distance (nth 0 ins3) (nth 0 ins4)) (distance (nth 0 ins1) (nth 0 ins2)) ) 2)  ;; (dist2 - dist1) / 2
        )
        (- (nth (+ i 1) xvalues ) (nth i xvalues))                                              ;; horizontal dist
      )
    ))
    
    (setq i (+ i 1))
  )
 
  ;; The result
  (setq result (/ surfacesum (- (last xvalues) (nth 0 xvalues))) )  
  ;; remove the X-lines
  (foreach x xlines
    (entdel x)
  )

  (princ "\nTotal surface: ")
  (princ surfacesum)
  (princ "\nAverage vertical distance: ")
  (princ result)
  (ALERT result)
  
 
  (princ)
)

 

 

 

well, you gave me some new ideas with those xlines ...will try, thanx

 

in the meantime if anyone makes something feel free to post 

[BIGAL]

Try this, it can be improved but lots more code, will work with 1st pline shorter than second.

 

;   https://www.cadtutor.net/forum/topic/71254-closed-polyline-between-two-polylines/

; pline boundary with vertical ends 
; by AlanH SEP 2020

(vl-load-com)
(defun c:plend ( / obj1 obj2 ent pt1 pt2 pt3  pickpt)
(setq EN (entsel "pick 1st short  pline near end"))
(setq pickpt1 (cadr en))
(setq ENt (vlax-ename->vla-object (car en)))
(setq pt1
(car (vl-sort (list (vlax-curve-getStartPoint ENt) (vlax-curve-getEndPoint ENt))
              (function (lambda (a b) (< (distance Pickpt1 a) (distance Pickpt1 b))))
     )
)
)
(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick 2nd pline"))))
(setq pt2 (polar pt1 (/ pi 2.0) 10))
(command "line" pt1 pt2 "")
(setq obj1 (vlax-ename->vla-object (entlast)))
(setq pt2 (vlax-invoke obj1 'Intersectwith obj2 1))
(vla-delete obj1)
(command "line" pt1 pt2 "")
(setq ent1 (entlast))
(setq EN (entsel "pick 1st short pline near end"))
(setq pickpt (cadr en))
(setq ENt (vlax-ename->vla-object (car en)))
(setq pt1
(car (vl-sort (list (vlax-curve-getStartPoint ENt) (vlax-curve-getEndPoint ENt))
              (function (lambda (a b) (< (distance Pickpt a) (distance Pickpt b))))
     )
)
)
(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick 2nd pline"))))
(setq pt2 (polar pt1 (/ pi 2.0) 10))
(command "line" pt1 pt2 "")
(setq obj1 (vlax-ename->vla-object (entlast)))
(setq pt2 (vlax-invoke obj1 'Intersectwith obj2 1))
(vla-delete obj1)
(command "line" pt1 pt2 "")
(setq ent2 (entlast))
(setq pt3  (mapcar '+ pt1 pt2))
(setq pt3  (mapcar '/ pt3 '(2.0 2.0)))
(setq pt3 (polar pt3 (angle pt1 pickpt1)  10))
(command "bpoly" pt3 "")
(command "erase" ent1 ent2 "")
(princ)
)
(c:plend)

 

Edited October 1, 2020 by BIGAL

[Tomislav]

will try, thank you too...

[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! ***|;

all right, I got so far...

 

now can someone help me why I'm not getting right_xcross and left_xcross correctly?

[Tharwat]

The shortest way could be this way I believe.

 

(defun c:Test (/ p1 p2 p3 ss c1 c2 sr nw cd)
  ;; Tharwat - 29.Sep.2020	;;
  (and
    (or (/= 4
            (logand
              4
              (cdr
                (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER))))
              )
            )
        )
        (alert "Current layer is locked!. Unlock then try again.")
    )
    (setq p1 (getpoint "\nSpecify end point of first polyline : "))
    (or (setq ss (ssget p1 '((0 . "LWPOLYLINE"))))
        (alert "No LWpolyline found at that point. Try again.")
    )
    (setq c1 (mid_ ss))
    (setq p2 (getcorner "\nSpecify end point of second polyline : " p1))
    (or (setq ss (ssget p2 '((0 . "LWPOLYLINE"))))
        (alert "No LWpolyline found at that point. Try again.")
    )
    (setq c2 (mid_ ss))
    (setq st (entlast)
          cd (vlax-get-acad-object)
    )
    (progn
      (vl-cmdf "_.RECTANG" "_none" p1 "_none" p2)
      (if (/= st (setq nw (entlast)))
        (progn
          (vla-ZoomExtents cd)
          (command "_.-boundary"
                   "_none"
                   (mapcar '(lambda (j k) (/ (+ j k) 2.0)) c1 c2)
                   ""
          )
          (entdel nw)
          (vla-Zoomprevious cd)
        )
      )
    )
  )
  (princ)
) (vl-load-com)
(defun mid_ (ss / ent len mid)
  (setq ent (ssname ss 0)
        len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
        mid (vlax-curve-getpointatdist ent (/ len 2.0))
  )
  mid
)

 

[Tomislav]

Hello Tharwat, very good lisp but I'm getting this

and what about when one poly is longer on both sides?

Edited September 29, 2020 by Tomislav

[Tharwat]

Alright, this should cover more cases.

(defun c:Test (/ p1 p2 p3 ss c1 c2 x1 x2 sp cd)
  ;; Tharwat - 29.Sep.2020	;;
  (and
    (or (/= 4
            (logand
              4
              (cdr
                (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER))))
              )
            )
        )
        (alert "Current layer is locked!. Unlock then try again.")
    )
    (setq p1 (getpoint "\nSpecify end point of first polyline : "))
    (or (setq ss (ssget p1 '((0 . "LWPOLYLINE"))))
        (alert "No LWpolyline found at that point. Try again.")
    )
    (setq c1 (mid_ ss))
    (setq p2 (getcorner "\nSpecify end point of second polyline : " p1))
    (or (setq ss (ssget p2 '((0 . "LWPOLYLINE"))))
        (alert "No LWpolyline found at that point. Try again.")
    )
    (setq c2 (mid_ ss))
    (setq cd (vlax-get-acad-object)
          sp (vla-get-block
               (vla-get-activelayout (vla-get-ActiveDocument cd))
             )
    )
    (setq x1 (vlax-invoke sp 'Addxline p1 (polar p1 (* pi 0.5) 1.0)))
    (setq x2 (vlax-invoke sp 'Addxline p2 (polar p2 (* pi 0.5) 1.0)))
    (progn
      (vla-ZoomExtents cd)
      (command "_.-boundary"
               "_none"
               (mapcar '(lambda (j k) (/ (+ j k) 2.0)) c1 c2)
               ""
      )
      (mapcar 'vla-delete (list x1 x2))
      (vla-Zoomprevious cd)
    )
  )
  (princ)
)
(vl-load-com)
(defun mid_ (ss / ent len mid)
  (setq ent (ssname ss 0)
        len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
        mid (vlax-curve-getpointatdist ent (/ len 2.0))
  )
  mid
)

 

[Tomislav]

well, it does cover this last example, but still there's no solution for one poly being longer on both sides, and it doesn't work with 2dpolylines...

my idea is based on that I make xlines on shorter end, get crossing points on longer ends, lose the vertices on longer ends based on those points, add that points to vertex list and then create one poly from all those points...

Edited September 29, 2020 by Tomislav

[Tharwat]

Just now, Tomislav said:

well, it does cover this last example, but still there's no solution for one poly being longer on both sides, and it doesn't work with 2dpolylines...

It does account for the circumstances that you described into this thread and its not a paid program.

[Tomislav]

1 minute ago, Tharwat said:

It does account for the circumstances that you described into this thread and its not a paid program.

 

yes I know, that's why I posted my lisp and needed help with debugging it...

[devitg]

2 hours ago, Tomislav said:

 

yes I know, that's why I posted my lisp and needed help with debugging it...

Hi Tomislav , please upload a true working dwg with all possible case , the one you work on now . Not a sample , a real and true dwg. 

About different case it could be:

the top is at left from bottom 

the top is at right from bottom

top longer than bottom or viceversa  

top shorter than bottom or viceversa

poly was drawn from left to right 

top -> , and bottom <-  

 

 

 

[BIGAL]

Updated code above like devitg works with every thing I test on. Need real dwg. Its a bit more manual than nice Tharwat method. 

[Tomislav]

Here it is, I copied it from my job without the clutter around it, and it's all you devitg said..  

example.dwg

[dlanorh]

After shamelessly stealing @Tharwat's code here is my take on said code

 

(defun rh:getlwp ( msg / flg ss ent)
  (while (not flg)
    (prompt (strcat "\nSelect " msg " Polyline : "))
    (setq ss (ssget "_+.:E:S:L" '((0 . "LWPOLYLINE"))))
    (cond (ss (setq ent (ssname ss 0) flg T))
          (t (alert "Nothing Selected"))
    );end_cond
  );end_while
  ent
);end_defun

(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

(vl-load-com)

(defun c:Test (/ *error* a_app c_doc c_spc sv_lst sv_vals ss uent lent ulst llst ss c1 c2 x1 x2 x3 x4)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
    (princ)
  );end_defun

  (setq a_app (vlax-get-acad-object)
        c_doc (vla-get-activedocument a_app)
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        ss (ssadd)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (cond ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER)))))) (alert "Current layer is locked!. Unlock then try again.")))

  (setq uent (rh:getlwp "Upper")
        c1 (vlax-curve-getpointatdist uent (/ (vlax-curve-getdistatparam uent (vlax-curve-getendparam uent)) 2.0))
        lent (rh:getlwp "Lower")
        c2 (vlax-curve-getpointatdist lent (/ (vlax-curve-getdistatparam lent (vlax-curve-getendparam lent)) 2.0))
  );end_setq

  (foreach x (list uent lent) (ssadd x ss))

  (setq lst (LM:ssboundingbox ss))

  (vlax-invoke a_app 'zoomwindow (car lst) (cadr lst))

  (setq x1 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getstartpoint uent)) (polar pt (* pi 0.5) 1.0))
        x2 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getendpoint uent)) (polar pt (* pi 0.5) 1.0))
        x3 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getstartpoint lent)) (polar pt (* pi 0.5) 1.0))
        x4 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getendpoint lent)) (polar pt (* pi 0.5) 1.0))
        pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) c1 c2)
  );end_setq
  (vl-cmdf "_-boundary" pt "")
  (mapcar 'vla-delete (list x1 x2 x3 x4))

  (vlax-invoke a_app 'zoomprevious)
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

 

Just select the upper and lower lwpolylines. I have asked for upper and lower in that order, but I don't think the order matters.

[Tomislav]

'we meet again dlanorh'  

your lisp works great, only limitation is to lwpolylines.

I've noticed you limited selection to them so I changed

(setq ss (ssget "_+.:E:S:L" '((0 . "LWPOLYLINE"))))

to

(setq ss (ssget "_+.:E:S:L" '((0 . "LWPOLYLINE,POLYLINE"))))

and now it works most of the time...

 

thank you ALL for participating 

 

 

p.s. it even works with 3dpolylines

Edited September 30, 2020 by Tomislav