motee-z Posted December 30, 2006 Share Posted December 30, 2006 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 Quote Link to comment Share on other sites More sharing options...
Danielm103 Posted December 31, 2006 Share Posted December 31, 2006 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) ) Quote Link to comment Share on other sites More sharing options...
fixo Posted December 31, 2006 Share Posted December 31, 2006 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'~ Quote Link to comment Share on other sites More sharing options...
Danielm103 Posted December 31, 2006 Share Posted December 31, 2006 Nice Just a thought, you might want to check the length of the selection set(ss) to verify there are indeed two lines Dan Quote Link to comment Share on other sites More sharing options...
fixo Posted December 31, 2006 Share Posted December 31, 2006 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'~ Quote Link to comment Share on other sites More sharing options...
SEANT Posted December 31, 2006 Share Posted December 31, 2006 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 Quote Link to comment Share on other sites More sharing options...
motee-z Posted December 31, 2006 Author Share Posted December 31, 2006 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 Quote Link to comment Share on other sites More sharing options...
Danielm103 Posted December 31, 2006 Share Posted December 31, 2006 Did you try mine? Thanks Edit : oops sorry I don't think I understood the question correctly Dan Quote Link to comment Share on other sites More sharing options...
motee-z Posted January 1, 2007 Author Share Posted January 1, 2007 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 Quote Link to comment Share on other sites More sharing options...
SEANT Posted January 1, 2007 Share Posted January 1, 2007 Sorry I couldn't help out with a lisp routine. But, a not so automated process is available with plain autocad. Quote Link to comment Share on other sites More sharing options...
fixo Posted January 1, 2007 Share Posted January 1, 2007 thank you Fatty my aim to get centerline of 2 linesI 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'~ Quote Link to comment Share on other sites More sharing options...
motee-z Posted January 1, 2007 Author Share Posted January 1, 2007 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted January 2, 2007 Share Posted January 2, 2007 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'~ Quote Link to comment Share on other sites More sharing options...
pefi Posted January 2, 2007 Share Posted January 2, 2007 Another point of view... Points on _both_ continuous white lines are with the same distance to green lines.... Happy New Year! Przemo Quote Link to comment Share on other sites More sharing options...
fixo Posted January 2, 2007 Share Posted January 2, 2007 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'~ Quote Link to comment Share on other sites More sharing options...
motee-z Posted January 2, 2007 Author Share Posted January 2, 2007 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 Quote Link to comment Share on other sites More sharing options...
pefi Posted January 2, 2007 Share Posted January 2, 2007 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: Quote Link to comment Share on other sites More sharing options...
VVA Posted January 3, 2007 Share Posted January 3, 2007 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted January 3, 2007 Share Posted January 3, 2007 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'~ Quote Link to comment Share on other sites More sharing options...
Danielm103 Posted January 3, 2007 Share Posted January 3, 2007 Welcome VVA Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.