Draw line in the mid distance of 2 existing lines

Hello and happy new year for all

my request is autolisp routin that can creat a line from 2 existing lines may parallel or not and every point of this line has the same distance to 2 lines

thanks

This has no error checking, but its a start for you

Dan

(defun c:test ( / activedocument ename1 ename2 iacadapplication modelspace mp1 mp2 object1 object2)
(setq IAcadApplication (vlax-get-acad-object)
      ActiveDocument (vla-get-ActiveDocument IAcadApplication)
      ModelSpace (vla-get-ModelSpace ActiveDocument)
      EName1 (car (entsel "\nSelect the first line: "))
      EName2 (car (entsel "\nSelect the Second line: "))
      object1 (vlax-ename->vla-object EName1)
      object2 (vlax-ename->vla-object EName2)
      mp  (lambda (p1 p2) (mapcar (function(lambda(a b)(/(+ a b 0.0) 2.0))) p1 p2))
      mp1 (mp (vlax-get object1 'StartPoint) (vlax-get object1 'EndPoint))
      mp2 (mp (vlax-get object2 'StartPoint) (vlax-get object2 'EndPoint))
)
(vla-AddLine ModelSpace (vlax-3d-point mp1) (vlax-3d-point mp2))
(princ)
)

Here is my two cents

(defun C:MLL (/	     *error*	   acsp	  adoc	 dlt1	dlt2   ep1
      ep2    flag   int1   int2	  ip	line1	 line2	nxp    ocirc
      p1     p2	    rad	   sp1	  sp2	 ss	tmp    x
      xline1
     )
 (if (< (atoi (substr (getvar "acadver") 1 2)) 15)
   (progn
     (alert
"Programm wiil be works in\n
AutoCAD 2000 and higher versions"
     )
     (exit)
     (princ)
   )
 )

 (or (vl-load-com))
;=====================================;
 (defun *error* (msg)
   (princ msg)
   (vla-endundomark
     (vla-get-activedocument
(vlax-get-acad-object)
     )
   )
   (princ)
 )

 (defun midpoint (p1 p2)
   (mapcar (function (lambda (a b)
		(* (+ a b) 0.5)
	      )
    )
    p1
    p2
   )
 )
;=====================================;
 (defun group-by-num (lst num / ls ret)
   (if	(= (rem (length lst) num) 0)
     (progn
(setq ls nil)
(repeat	(/ (length lst) num)
  (repeat num
    (setq ls
	      (cons (car lst) ls)
	  lst (cdr lst)
    )
  )
  (setq	ret (append ret (list (reverse ls)))
	ls  nil
  )
)
     )
   )
   ret
 )
;=====================================;
 (or adoc
     (setq adoc (vla-get-activedocument
	   (vlax-get-acad-object)
	 )
     )
 )
 (or acsp
     (setq acsp (if (= (getvar "CVPORT") 1)
	   (vla-get-paperspace
	     adoc
	   )
	   (vla-get-modelspace
	     adoc
	   )
	 )
     )
 )

 (vla-endundomark
   adoc
 )
 (vla-startundomark
   adoc
 )
 (setq ss (ssget (list (cons 0 "LINE"))))
 (if (/= (sslength ss) 2)
   (progn
     (alert "Must be selected 2 lines only")
     (exit)
     (princ)
   )
 )
 (setq	line1 (vlax-ename->vla-object (ssname ss 0))
line2 (vlax-ename->vla-object (ssname ss 1))
sp1   (vlax-get line1 'StartPoint)
ep1   (vlax-get line1 'EndPoint)
sp2   (vlax-get line2 'StartPoint)
ep2   (vlax-get line2 'EndPoint)
dlt1  (vlax-get line1 'Angle)
dlt2  (vlax-get line2 'Angle)

 )
 (if (or (equal dlt1 dlt2 1e-08)
  (equal dlt1 (+ pi dlt2) 1e-08)
     )	;parallel lines
   (setq flag t)
   (setq flag nil)
 )

 (if flag
   (progn
     (if
(< (distance sp1 sp2) (distance sp1 ep2))
 (progn
   (setq p1 (midpoint sp1 sp2)
	 p2 (midpoint ep1 ep2)
   )
 )
 (progn
   (setq p1 (midpoint sp1 ep2)
	 p2 (midpoint ep1 sp2)
   )
 )
     )
     (setq xline1 (vlax-invoke acsp 'AddXline p1 p2))
   )
   (progn
     (setq tmp (vlax-invoke line1 'Intersectwith line2 acextendboth))
     (setq rad	(distance tmp
		  (setq	p1
			 (car (vl-sort
				(list sp1 sp2 ep1 ep2)
				(function (lambda (a b)
					    (< (distance tmp a) (distance tmp b))
					  )
				)
			      )
			 )
		  )
	)
     )
     (if (vl-some (function (lambda (a)
		       (equal tmp a 1e-08)
		     )
	   )
	   (list sp1 sp2 ep1 ep2)
  )
(setq rad 0.001)
     )
     (setq ocirc (vlax-invoke acsp 'AddCircle tmp rad))
     (setq int1 (group-by-num
	   (vlax-invoke ocirc 'Intersectwith line1 acextendnone)
	   3
	 )
    int2 (group-by-num
	   (vlax-invoke ocirc 'Intersectwith line2 acextendnone)
	   3
	 )
     )
     (setq
nxp (vl-remove-if (function not)(vl-sort (append int1 int2)
	     (function (lambda (a b)
			 (< (distance sp1 a) (distance sp1 b))
		       )
	     )
    )
      )
)
     (if (= (length nxp) 1)
(progn
  (if int1

    (setq ip (polar tmp (angle tmp (vlax-get line2 'StartPoint))
		  (distance tmp int1)))

  (setq ip (polar tmp (angle tmp (vlax-get line1 'StartPoint))
		  (distance tmp int2)))
    )
  (setq p2 (midpoint (car nxp) ip))
  )
     (setq p2 (midpoint (car nxp) (cadr nxp)))
)
     (setq xline1 (vlax-invoke acsp 'AddXline tmp p2))
   )
 )


 (mapcar (function (lambda (x)
	      (vl-catch-all-apply
		(function (lambda ()
			    (progn
			      (vla-delete ocirc)
			      (vlax-release-object x)
			    )
			  )
		)
	      )
	    )
  )
  (list line1 line2 ocirc xline1)
 )
 (*error* nil)
 (princ)
)

~'J'~

Nice

Just a thought, you might want to check the length of the selection set(ss) to verify there are indeed two lines

Dan

Nice

Just a thought, you might want to check the length of the selection set(ss) to verify there are indeed two lines

Dan

I agreed with you

Good point

~'J'~

The method of averaging endpoints to generate an equi-distant line gives odd results when the two originals are of different lengths. Especially when they intersect (see below). A bisector line may (or may not) be what the OP is requesting.

I don't know Lisp, so my contribution is in VBA. As usual for a demo routines, there is limited error checking. Also, this does nor accomodate parallel lines.

Sub BisectorLine()
Dim entTemp As AcadEntity
Dim entLine1 As AcadLine
Dim entLine2 As AcadLine
Dim entCircle As AcadCircle
Dim entBisector As AcadXline
Dim varTempPoint As Variant
Dim varTempPoint2 As Variant
Dim arrDblPT(2) As Double
  ThisDrawing.Utility.GetEntity entTemp, varTempPoint, "Select first line: "
  If Not entTemp.ObjectName = "AcDbLine" Then Exit Sub
  Set entLine1 = entTemp.Copy
  ThisDrawing.Utility.GetEntity entTemp, varTempPoint, "Select second line: "
  If Not entTemp.ObjectName = "AcDbLine" Then Exit Sub
  Set entLine2 = entTemp.Copy
  varTempPoint = entLine1.IntersectWith(entLine2, acExtendBoth)
  entLine1.StartPoint = varTempPoint
  entLine2.StartPoint = varTempPoint
  Set entCircle = ThisDrawing.ModelSpace.AddCircle(varTempPoint, 1) 'this demo for limited scale modelspace only
  varTempPoint = entCircle.IntersectWith(entLine1, acExtendNone)
  varTempPoint2 = entCircle.IntersectWith(entLine2, acExtendNone)
  arrDblPT(0) = (varTempPoint(0) + varTempPoint2(0)) / 2
  arrDblPT(1) = (varTempPoint(1) + varTempPoint2(1)) / 2
  arrDblPT(2) = 0 'this demo for WCS only
  Set entBisector = ThisDrawing.ModelSpace.AddXline(entCircle.Center, arrDblPT)
  entLine1.Delete
  entLine2.Delete
  entCircle.Delete
  Set entLine1 = Nothing
  Set entLine2 = Nothing
  Set entCircle = Nothing
  Set entBisector = Nothing
End Sub

thank you Fatty my aim to get centerline of 2 lines

I try the routin it work if lines are parallel but if not the result is not okay because if we take one point of the result line and measure the pependicular distance to both 2 lines it gives different measure so i think we must cosider the bisector as SEANT say sorry i cant undestand vb

thanks

Did you try mine?

Thanks

Edit : oops sorry I don't think I understood the question correctly

Dan

thank you Danielm103 i try your routin but it dos,nt work as i want it draws line from midpoint of first line to midpoint of second line my request is to find a line every point from it has equal distance from the 2 lines

thank you for your effort wainting for response

Sorry I couldn't help out with a lisp routine.

But, a not so automated process is available with plain autocad.

thank you Fatty my aim to get centerline of 2 lines

I try the routin it work if lines are parallel but if not the result is not okay because if we take one point of the result line and measure the pependicular distance to both 2 lines it gives different measure so i think we must cosider the bisector as SEANT say sorry i cant undestand vb

thanks

Do not agree with you

This routine works for me in any cases

with each lines (parallel or not)

Tested on A2005 only

By the way Daniel's routine works for me

nice too

Next time I recommend you to attach

a sample drawing with you your problem

~'J'~

Hi Fatty

the image attached by SEANT POST explain the problem

your routin creat a line from midpoint of 2 line

first line is conected between endpoint of first given line and endpoint of second given line , second line conected between end point of second given line and endpoint of first given line

please check SEANT post

sorry for that

Hi Fatty

the image attached by SEANT POST explain the problem

your routin creat a line from midpoint of 2 line

first line is conected between endpoint of first given line and endpoint of second given line , second line conected between end point of second given line and endpoint of first given line

please check SEANT post

sorry for that

Oh, my bad

You are right, sorry

See revised code in my first thread

~'J'~

Another point of view...

Points on _both_ continuous white lines are with the same distance to green lines....

Happy New Year!

Przemo

Another point of view...

 

Points on _both_ continuous white lines are with the same distance to green lines....

 

Happy New Year!

Przemo

Hi friend, glad you back

You know I am so stupid, better yet

send me e-mail with sample drawing and

add there some explanation for old idiot

Happy New Year again!

~'J'~

Hi freind Fatty

Happy new year for you and all

the routin draw only a circle in the intersection of the 2 lines if the lines not parallel and if parallel can you break it to make it shorter

Hi,

I think we both should wait for motee-z to say what he wants...

It seems to me that he needs just xline / bisection which uses crosssection point of 2 lines (real or after extension) as angle vertex point.

pefi

P.S Thanks for wishes "neighbour" :wink:

Here my lisp for draw polyline in the mid distance of 2 objects

 
(defun C:MPL (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm)
 (defun *error* (msg)
   (vla-Regen adoc acActiveViewport)
   (vla-EndUndoMark adoc)
   (setvar "OSMODE" osm)
 ) ;_ end of defun
 (vl-load-com)
 (setq osm (getvar "OSMODE"))
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-StartUndoMark adoc)
 (setvar "CMDECHO" 0)
 (setq crvs (mapcar '(lambda (y / en)
                       (setq en
                              (car (entsel (strcat "\nSelect " y " edge: ")))
                       ) ;_ end of setq
                       (if en
                         (redraw en 3)
                       ) ;_ end of if
                       en
                     ) ;_ end of lambda
                    '("first" "second")
            ) ;_ end of mapcar
 ) ;_ end of setq
 (if (vl-some 'null crvs)
   (alert "Shortage!!!")
   (progn
     (mapcar '(lambda (x) (redraw x 4)) crvs)
     (setq crvs (mapcar 'vlax-ename->vla-object crvs))
     (if (apply
           'and
           (mapcar
             '(lambda (x)
                (wcmatch (strcase (vla-get-ObjectName x)) "*LINE,ARC")
              ) ;_ end of lambda
             crvs
           ) ;_ end of mapcar
         ) ;_ end of apply
       (progn
         (setq eps (mapcar '(lambda (x)
                              (- (vlax-curve-getEndParam x)
                                 (vlax-curve-getStartParam x)
                              ) ;_ end of -
                            ) ;_ end of lambda
                           crvs
                   ) ;_ end of mapcar
         ) ;_ end of setq
         (initget 6)
         (setq dL
                (if
                  (setq dL (getint "\nQuantity of reference points <100>: "))
                   dL
                   100
                ) ;_ end of if
         ) ;_ end of setq
         (setq pts (mapcar '(lambda (dp crv / sps pr)
                              (setq n 0)
                              (while (< n dl)
                                (setq pr  (* (/ dp dl) n)
                                      pt  (vlax-curve-getPointAtParam crv pr)
                                      sps (append sps (list pt))
                                      n   (1+ n)
                                ) ;_ end of setq
                              ) ;_ end of while
                              sps
                            ) ;_ end of lambda
                           eps
                           crvs
                   ) ;_ end of mapcar
         ) ;_ end of setq
         (setq pts
                (mapcar
                  '(lambda (pt pr crv)
                     (append pt
                             (list (vlax-curve-getPointAtParam crv pr))
                     ) ;_ end of append
                   ) ;_ end of lambda
                  pts
                  eps
                  crvs
                ) ;_ end of mapcar
         ) ;_ end of setq
         (setq pts
                (mapcar
                  '(lambda (crv pt)
                     (vl-sort pt
                              '(lambda (t1 t2)
                                 (< (vlax-curve-getDistAtParam
                                      crv
                                      (vlax-curve-getParamAtPoint crv t1)
                                    ) ;_ end of vlax-curve-getDistAtParam
                                    (vlax-curve-getDistAtParam
                                      crv
                                      (vlax-curve-getParamAtPoint crv t2)
                                    ) ;_ end of vlax-curve-getDistAtParam
                                 ) ;_ end of <
                               ) ;_ end of lambda
                     ) ;_ end of vl-sort
                   ) ;_ end of lambda
                  crvs
                  pts
                ) ;_ end of mapcar
         ) ;_ end of setq
         (setq
           pts (mapcar
                 '(lambda (x) (mapcar '(lambda (y) (trans y 0 1)) x))
                 pts
               ) ;_ end of mapcar
         ) ;_ end of setq
         (setq pt1 (car pts)
               pt2 (cadr pts)
         ) ;_ end of setq
         (if (> (+ (distance (car pt1) (car pt2))
                   (distance (last pt1) (last pt2))
                ) ;_ end of +
                (+ (distance (car pt1) (last pt2))
                   (distance (last pt1) (car pt2))
                ) ;_ end of +
             ) ;_ end of >
           (setq pt2 (reverse pt2))
         ) ;_ end of if
         (setq
           ptc (mapcar
                 '(lambda (t1 t2)
                    (polar t1 (angle t1 t2) (* 0.5 (distance t1 t2)))
                  ) ;_ end of lambda
                 pt1
                 pt2
               ) ;_ end of mapcar
         ) ;_ end of setq
         (setvar "OSMODE" 0)
         (vl-cmdf "_.PLINE" (car ptc) "_W" 0 0)
         (foreach pt (cdr ptc) (vl-cmdf pt))
         (vl-cmdf "")
       ) ;_ end of progn
     ) ;_ end of if
   ) ;_ end of progn
 ) ;_if apply
 (setvar "OSMODE" osm)
 (vla-EndUndoMark adoc)
 (princ)
) ;_ end of defun

1. As edges it is supposed to choose all POLYLINE, SPLINE, ARC, LINE

2. Crossings of curves are not analyzed

3. Quantity of reference points - on how many parts the curve for reception of an average line is broken

Hi freind Fatty

Happy new year for you and all

the routin draw only a circle in the intersection of the 2 lines if the lines not parallel and if parallel can you break it to make it shorter

I have a found one little bug there

See my revised routine in the original thread

Let me know if something wrong again...

and thank you too

~'J'~

Welcome VVA