Get distances between selected polylines

[DC-MWA]

Hello all,

I'm working on a routine to assist in calculating frontage increase for building area.

At this point there is a lot of clicking/picking involved with getting the input data from the user

;;pick wall face points
(setq P1 (getpoint "\nPick 1st end of wall: "))
(setq P2 (getpoint "\nPick 2nd end of wall: "))
(setq F (distance P1 P2))

;;pick yard points
(setq Y1 (getpoint "\nPick building corner: "))
(setvar "osmode" 640)
(setq Y2 (getpoint Y1 "\nPick perpendicular property line or center of public way: "))
(setvar "osmode" 1)
(setq Y3 (getpoint "\nPick building corner: "))
(setvar "osmode" 640)
(setq Y4 (getpoint Y3 "\nPick perpendicular property line or center of public way: "))

(setq DIST1 (distance Y1 Y2))
(setq DIST2 (distance Y3 Y4))

I'm looking to simplify the selection process. I'm hoping somebody has already done something similar.

I have provided an image of what I'm hoping to achieve

[DC-MWA]

Ok...

I figured out the Polyline segment length portion.

[CodeDing]

@DC-MWA ,

While the idea of what you're looking for is a pretty easy concept, I do not believe the coding aspect would be so easy.

When trying to calculate the area/distance between the Building and the Boundary, there is just SO much that would need to be accounted for (e.g. shape of the building, location of the building, shape of the boundary, location of the boundary, criteria to determine how the area must be calculated if building or boundary are irregular).

So if the AREA command does not solve what you are looking for, then I believe you are on the best track. Here's my contribution:

;user input
(setq osm (getvar 'OSMODE))
(setvar 'OSMODE 1)
(initget 1) (setq b1 (getpoint "\nPick building corner 1: "))
(setvar 'OSMODE 640)
(initget 1) (setq p1 (getpoint b1 "\nPick perpendicular boundary 1: "))
(setvar 'OSMODE 1)
(initget 1) (setq b2 (getpoint "\nPick building corner 2: "))
(setvar 'OSMODE 640)
(initget 1) (setq p2 (getpoint b2 "\nPick perpendicular boundary 2: "))
(setvar 'OSMODE osm)
;calcs
(setq bldgLen (distance b1 b2)
      d1 (distance b1 p1)
      d2 (distance b2 p2)
      ;area calculation was incorrect (removed)
);setq

Best,

~DD

[dlanorh]

Are you just interested in the area, or do you need the distances as well?

[dlanorh]

Oops hit post before including the code 😂

(defun gc:clockwise-p ( p1 p2 p3 ) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14))

(defun c:test ( / c_doc c_spc u p d_ent v_lst p_pt c_pt v_p pt1 pt2 pt0 ang seg_len b_ent b_obj x_obj pt3 pt4 d1 d2 nv_lst n_obj area)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        u (getvar 'lunits)
        p (getvar 'luprec)
        d_ent (car (setq sel (entsel "\nSelect Building Polyline on Frontage : ")))
        v_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget d_ent)))
        p_pt (cadr sel)
        c_pt (vlax-curve-getclosestpointto d_ent p_pt)
        v_p (fix (vlax-curve-getparamatpoint d_ent c_pt))
        pt1 (reverse (cons 0.0 (reverse (nth v_p v_lst))))
        pt2 (reverse (cons 0.0 (reverse (nth (1+ v_p) v_lst))))
        pt0 (reverse (cons 0.0 (reverse (nth (1- v_p) v_lst))))
  );end_setq
  (if (gc:clockwise-p pt0 pt1 pt2)
    (setq ang (+ (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv d_ent v_p)) (* pi 0.5)) pt0 T)
    (setq ang (- (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv d_ent v_p)) (* pi 0.5)) pt0 nil)
  );end_if
  (setq seg_len (distance (nth v_p v_lst) (nth (1+ v_p) v_lst))
        b_ent (car (entsel "\nSelect Boundary Polyline : "))
        b_obj (vlax-ename->vla-object b_ent)
        x_obj (vlax-invoke c_spc 'addray pt1 (polar pt1 ang 10.0))
        pt3 (vlax-invoke x_obj 'intersectwith b_obj acextendnone)
  );end
  (vlax-invoke x_obj 'move pt1 pt2)
  (setq pt4 (vlax-invoke x_obj 'intersectwith b_obj acextendnone))
  (vla-delete x_obj)
  (if pt0
    (setq d1 (distance pt1 pt3) d2 (distance pt2 pt4))
    (setq d1 (distance pt2 pt4) d2 (distance pt1 pt3))
  );end_if
  (setq nv_lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) (list pt1 pt2 pt4 pt3))
        n_obj (vlax-invoke c_spc 'addlightweightpolyline (apply 'append nv_lst))
        area (vlax-get-property n_obj 'area)
  );end_setq
  (vlax-put-property n_obj 'closed :vlax-true) ;;THIS LINE DISPLAYS THE POLYLINE AROUND THE AREA. DELETE IF NOT NEEDED
  ;(vla-delete n_obj) ;; IF YOU DON'T NEED THE POLYLINE UNCOMMENT THIS LINE 
  (alert (strcat "Length of Frontage : " (rtos seg_len u p) "\n\nDistance to Boundary Left : " (rtos d1 u p)
                 "\n\nDistance to Boundary Right : " (rtos d2 u p) "\n\nArea : " (rtos area u p)
         );end_strcat
  );end_alert
  (princ)
);end_defun

[DC-MWA]

Wow,

This is exactly what I needed.

It crashes on certain sides or directions or?

I also tried it with rectangle inside a rectangle and it still crashed on two sides??

[DC-MWA]

That wasn't an area calculation it was a "weighted average" caclulation.

[CADaSchtroumpf]

My basic try:

(vl-load-com)
(defun e_sel (msg flag / ent e dxf_ent)
	(while flag
		(while (not (setq ent (entsel msg))))
		(setq dxf_ent (entget (setq e (car ent))))
		(if (eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
			(setq flag nil)
			(princ "\nIsn't a polyline.")
		)
	)
	(list ent e dxf_ent)
)
(defun c:test ( / AcDoc flag *error* rtn pn-1 pn+1 pt1 pt2 alpha pt3 pt4 pt_int1 pt_int2)
	(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
	(vla-StartUndoMark AcDoc)
	(defun *error* (msg)
		(and
			msg
			(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
			(princ (strcat "\nError: " msg))
		)
		(if
			(= 8 (logand (getvar "UNDOCTL") 8))
			(vla-endundomark AcDoc)
		)
		(princ)
	)
	(setq
		rtn (e_sel "\nSelect Building Polyline on Frontage : " T)
		pn-1 (fix (vlax-curve-getParamAtPoint (cadr rtn) (vlax-curve-getClosestPointTo (cadr rtn) (cadar rtn) nil)))
		pn+1 (if (>= (1+ pn-1) (cdr (assoc 90 (caddr rtn)))) 0 (1+ pn-1))
		pt1 (vlax-curve-getPointAtParam (cadr rtn) pn-1)
		pt2 (vlax-curve-getPointAtParam (cadr rtn) pn+1)
		alpha (angle pt1 pt2)
		rtn (e_sel "\nSelect Boundary Polyline : "T)
		pn-1 (fix (vlax-curve-getParamAtPoint (cadr rtn) (vlax-curve-getClosestPointTo (cadr rtn) (cadar rtn) nil)))
		pn+1 (if (>= (1+ pn-1) (cdr (assoc 90 (caddr rtn)))) 0 (1+ pn-1))
		pt3 (vlax-curve-getPointAtParam (cadr rtn) pn-1)
		pt4 (vlax-curve-getPointAtParam (cadr rtn) pn+1)
		pt_int1 (inters pt3 pt4 pt1 (polar pt1 (+ (* 0.5 pi) alpha) (distance pt1 pt3)) T)
		pt_int2 (inters pt3 pt4 pt2 (polar pt2 (+ (* 0.5 pi) alpha) (distance pt2 pt4)) T)
	)
;| *** remove for draw polyline and add Space to local
	(setq
		Space
		(if (eq (getvar "CVPORT") 1)
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
	)
	(vla-put-Closed (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) (list pt1 pt_int1 pt_int2 pt2)))) :vlax-true)
|; *** remove for draw polyline 
	(vla-EndUndoMark AcDoc)
	(alert
		(strcat
			"Length of Frontage : " (rtos (distance pt1 pt2))
			"\nFirst distance to Boundary : " (rtos (distance pt1 pt_int1))
			"\nSecond distance to Boundary : " (rtos (distance pt2 pt_int2))
			"\n\nArea : " (rtos (* (+ (distance pt1 pt_int1) (distance pt2 pt_int2)) 0.5 (distance pt1 pt2)))
		)
	)
	(prin1)
)

[DC-MWA]

This works also but I get random crashes. Is there a limit to the number of segments I have in the building polyline?

[dlanorh]

---

@DC-MWA wrote:

Wow,

This is exactly what I needed.

It crashes on certain sides or directions or?

I also tried it with rectangle inside a rectangle and it still crashed on two sides??

---

Yes, I've just seen the hole in my logic. Will try to sort tomorrow.

[DC-MWA]

Thank you. I truly appreciate your efforts.

[pbejse]

You mind posting the drawing file ( or parts of it) where the suggested solutions "crashes"?

[CADaSchtroumpf]

---

@DC-MWA  a écrit :

This works also but I get random crashes. Is there a limit to the number of segments I have in the building polyline?

---

I tried to harden the code to make it more reliable.

(vl-load-com)
(defun e_sel (msg flag / ent e dxf_ent)
	(while flag
		(while (not (setq ent (entsel msg))))
		(setq dxf_ent (entget (setq e (car ent))))
		(if (eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
			(setq flag nil)
			(princ "\nIsn't a polyline.")
		)
	)
	(list ent e dxf_ent)
)
(defun c:test ( / AcDoc flag *error* rtn pt pn-1 pn+1 pt1 pt2 deriv alpha pt3 pt4 v1 v2 det_or pt_int1 pt_int2 Space)
	(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
	(defun *error* (msg)
		(and
			msg
			(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
			(princ (strcat "\nError: " msg))
		)
		(if
			(= 8 (logand (getvar "UNDOCTL") 8))
			(vla-endundomark AcDoc)
		)
		(princ)
	)
	(setq
		rtn (e_sel "\nSelect Building Polyline on Frontage : " T)
		pt (vlax-curve-getClosestPointTo (cadr rtn) (trans (cadar rtn) 1 0) nil)
		pn-1 (fix (vlax-curve-getParamAtPoint (cadr rtn) pt))
		pn+1 (if (>= (1+ pn-1) (cdr (assoc 90 (caddr rtn)))) 0 (1+ pn-1))
		pt1 (vlax-curve-getPointAtParam (cadr rtn) pn-1)
		pt2 (vlax-curve-getPointAtParam (cadr rtn) pn+1)
		deriv (vlax-curve-getfirstderiv (cadr rtn) (vlax-curve-getparamatpoint (cadr rtn) pt))
		alpha (atan (cadr deriv) (car deriv))
		rtn (e_sel "\nSelect Boundary Polyline : "T)
		pn-1 (fix (vlax-curve-getParamAtPoint (cadr rtn) (vlax-curve-getClosestPointTo (cadr rtn) (trans (cadar rtn) 1 0) nil)))
		pn+1 (if (>= (1+ pn-1) (cdr (assoc 90 (caddr rtn)))) 0 (1+ pn-1))
		pt3 (vlax-curve-getPointAtParam (cadr rtn) pn-1)
		pt4 (vlax-curve-getPointAtParam (cadr rtn) pn+1)
		v1 (mapcar '- (polar pt alpha 1.0) pt)
		v2 (mapcar '- (trans (cadar rtn) 1 0) pt)
		det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2))
		pt_int1 (inters pt3 pt4 pt1 (polar pt1 (+ (if (> det_or 0.0) (* 0.5 pi) (* -0.5 pi)) alpha) (+ (distance pt1 pt3) (distance pt2 pt4))) nil)
		pt_int2 (inters pt3 pt4 pt2 (polar pt2 (+ (if (> det_or 0.0) (* 0.5 pi) (* -0.5 pi)) alpha) (+ (distance pt1 pt3) (distance pt2 pt4))) nil)
	)
	(cond
		((and pt_int1 pt_int2)
;*** the next lines can be deleted
			(setq
				Space
				(if (eq (getvar "CVPORT") 1)
					(vla-get-PaperSpace AcDoc)
					(vla-get-ModelSpace AcDoc)
				)
			)
			(vla-StartUndoMark AcDoc)
			(vla-put-Closed (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) (list pt1 pt_int1 pt_int2 pt2)))) :vlax-true)
			(vla-EndUndoMark AcDoc)
;**** end of remove
			(alert
				(strcat
					"Length of Frontage : " (rtos (distance pt1 pt2))
					"\nFirst distance to Boundary : " (rtos (distance pt1 pt_int1))
					"\nSecond distance to Boundary : " (rtos (distance pt2 pt_int2))
					"\n\nArea : " (rtos (* (+ (distance pt1 pt_int1) (distance pt2 pt_int2)) 0.5 (distance pt1 pt2)))
				)
			)
		)
		(T (princ "\nIntersections not found"))
	)
	(prin1)
)

[dlanorh]

OK try this version. Some changes. You are asked to select the boundary polyline first. You enter a loop to select building frontage, where you are asked to select a polyline segment. You can do this for multiple segments across a frontage. To exit the loop make a non (empty) selection. The alert box will show the total frontage distance, Left and Right to boundary (viewed from building looking to boundary) and total area. Lisp is also attached.

(defun rh:cwpl ( obj / o_obj)
  (setq o_obj (car (vlax-invoke obj 'Offset -0.01)) cw (if (> (vlax-get-property o_obj 'area) (vlax-get-property obj 'area)) T nil))
  (vla-delete o_obj)
  cw
);end_defun

(defun rh:rarea (plst spc / lst r_set ent area)
  (setq r_set (ssadd) lst (vlax-invoke spc 'addregion plst))
  (foreach x lst (ssadd (vlax-vla-object->ename x) r_set))
  (foreach x plst (vla-delete x))
  (command "union" r_set "")
  (if (= (cdr (assoc 0 (entget (setq ent (entlast))))) "REGION") (setq area (getpropertyvalue ent "area")) (setq area 0.0))
  ;(entdel ent)
  area
);end_defun

(defun c:test ( / *error* c_doc c_spc sv_lst sv_vals lu lp cnt d_ent sel v_lst vlen p_pt v_p pt1 pt2 ang chk slen b_obj x_obj pt3 pt4 d1 d2 nv_lst n_obj p_lst area)

  (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_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        lu (getvar 'lunits)
        lp (getvar 'luprec)
        cnt 0
        slen 0
  );end_setq

  (mapcar 'setvar sv_lst (list 0 0))

  (setq b_obj (vlax-ename->vla-object (car (entsel "\nSelect Boundary Polyline : "))))

  (while (setq sel (entsel "\nSelect Building Polyline on Frontage : "))
    (setq cnt (1+ cnt)
          d_ent (car sel)
          v_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget d_ent)))
          vlen (length v_lst)
          p_pt (cadr sel)
          v_p (fix (vlax-curve-getparamatpoint d_ent (vlax-curve-getclosestpointto d_ent p_pt)))
          pt1 (reverse (cons 0.0 (reverse (nth v_p v_lst))))
          pt2 (if (= v_p (1- vlen)) (reverse (cons 0.0 (reverse (nth 0 v_lst)))) (reverse (cons 0.0 (reverse (nth (1+ v_p) v_lst)))))
    );end_setq

    (if (rh:cwpl (vlax-ename->vla-object d_ent))
      (setq ang (+ (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv d_ent v_p)) (* pi 0.5)) chk T)
      (setq ang (- (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv d_ent v_p)) (* pi 0.5)) chk nil)
    );end_if

    (setq slen (+ slen (distance pt1 pt2))
          x_obj (vlax-invoke c_spc 'addray pt1 (polar pt1 ang 10.0))
          pt3 (vlax-invoke x_obj 'intersectwith b_obj acextendnone)
    );end_setq

    (vlax-invoke x_obj 'move pt1 pt2)
    (setq pt4 (vlax-invoke x_obj 'intersectwith b_obj acextendnone))
    (vla-delete x_obj)

    (cond ( (and chk (= cnt 1)) (setq d1 (distance pt2 pt4) d2 (distance pt1 pt3)));(setq d1 (distance pt1 pt3) d2 (distance pt2 pt4)))
          ( (and (not chk) (= cnt 1)) (setq d1 (distance pt1 pt3) d2 (distance pt2 pt4)));(setq d1 (distance pt2 pt4) d2 (distance pt1 pt3)))
          ( (and chk (> cnt 1)) (setq d2 (distance pt1 pt3)));(setq d2 (distance pt2 pt4)))
          ( (and (not chk) (> cnt 1)) (setq d2 (distance pt2 pt4)));(setq d2 (distance pt1 pt3)))
    );end_cond

    (setq nv_lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) (list pt1 pt2 pt4 pt3))
          n_obj (vlax-invoke c_spc 'addlightweightpolyline (apply 'append nv_lst))
    );end_setq
    (vlax-put-property n_obj 'closed :vlax-true)
    (setq p_lst (cons n_obj p_lst))
  );end_while

  (cond ( (= cnt 1) (setq area (vlax-get-property (car p_lst) 'area)))
        (t (setq area (rh:rarea p_lst c_spc)))
  );end_cond

  (alert (strcat "Length of Frontage : " (rtos slen lu lp) "\n\nDistance to Boundary Left : " (rtos d2 lu lp)
                 "\n\nDistance to Boundary Right : " (rtos d1 lu lp) "\n\nArea : " (rtos area lu lp)
         );end_strcat
  );end_alert

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

[DC-MWA]

I've been stress testing this all morning. So far so good.

[Kent1Cooper]

I have some questions:

For things related to setbacks and frontages, I think the distances you should be getting need to be perpendicular to the property boundary, not to the building face.  Your inclusion of PERpendicular mode in the OSMODE setting before picking the property boundary suggests that, anyway.  BUT:

Is there some reason to use 640 as an OSMODE value?  That includes NEArest mode, which will always  "win" over PERpendicular mode in this situation, meaning that the result will be distorted by the position of your cursor when you pick.  If you really want the distance in the direction perpendicular from the building face, just pick the property boundary regardless of Osnap settings, and if the building face and property boundary are always straight segments, the locations on the property boundary, and the distances, can be calculated with some (polar) and (inters) functions.

But as others have mentioned, the possibilities can be quite complicated if the building perimeter and/or property boundary involve curves, or changes in direction within the range of the area in question.  Do either of those things happen sometimes?

[DC-MWA]

Ok, this seems to work without crashing in many situations ive set up for testing.

 I really like the way it loops until done.

Am i unclear if the distances shown are the total distances added up for a total?

This is the ultimate goal.

For each selection:

W= add two distances and divide by 2 to get the weighted average. (/ (+ d1 d2) 2)

F = get the length of the polyline segment.

P = get total perimeter of building polyline

When loop ends:

Total all W's = ?

Total F's = ?

[dlanorh]

---

@DC-MWA wrote:

Ok, this seems to work without crashing in many situations ive set up for testing.

 I really like the way it loops until done.

Am i unclear if the distances shown are the total distances added up for a total?

This is the ultimate goal.

For each selection:

W= add two distances and divide by 2 to get the weighted average. (/ (+ d1 d2) 2)

F = get the length of the polyline segment.

P = get total perimeter of building polyline

When loop ends:

Total all W's = ?

Total F's = ?

---

If you select one segment the Left and Right are just that, the distance at 90 degrees from each end of the polyline segment at 90 d to the boundary; the segment length is the length of the segment and the area is the enclosed area from that

If you select more than one segment the segment length and area are totals but the Left and Right are the distance at the left and rignt ends of the selections. (see attached drawing where ABC etc are selections)  That being said, every distance you require is calculated/extracted.

[DC-MWA]

I get a different number for the Left Distance and the Right distance every time I use depending on where i start from?

I'll keep playing with it.

Thank you for your time.

[dlanorh]

I wasn't entirely sure what you were after on a frontage consisting of several parts and opted for Overall. If you want each part seperately that is possible, infact it would simplify the code somewhat. If you can provide a better brief for multi part frontages e.g. how you want the information returned/displayed  (csv, table, mtext in polyline....) , it can be easily adapted.