I am trying to draw a line between two lines and I put together the following. It works great if the start/end points are perpendicular to each other. How do I solve if line one start point is in a positive direction and line two is in a negative direction?
(defun c:test ()
(setq L1 (car (entsel "\nSelect the first line: "))
L2 (car (entsel "\nSelect the second line: "))
)
(setq P1 (cdr (assoc 10 (entget L1)))
P2 (cdr (assoc 11 (entget L1)))
P3 (cdr (assoc 10 (entget L2)))
P4 (cdr (assoc 11 (entget L2)))
)
(setq D1 (/ (distance P1 P3) 2)
D2 (/ (distance P2 P4) 2)
)
(setq A1 (angle P1 P3)
A2 (angle P2 P4)
)
(setq P5 (polar P1 A1 D1)
P6 (polar P2 A2 D2)
)
(command "LINE" P5 P6 "")
)
Solved! Go to Solution.
Solved by Kent1Cooper. Go to Solution.
Solved by pbejse. Go to Solution.
Solved by _Tharwat. Go to Solution.
@smaher12 wrote:I am trying to draw a line between two lines and I put together the following. It works great if the start/end points are perpendicular to each other. How do I solve if line one start point is in a positive direction and line two is in a negative direction?
(defun c:test ()
(setq L1 (car (entsel "\nSelect the first line: "))
L2 (car (entsel "\nSelect the second line: "))
)(setq P1 (cdr (assoc 10 (entget L1)))
P2 (cdr (assoc 11 (entget L1)))
P3 (cdr (assoc 10 (entget L2)))
P4 (cdr (assoc 11 (entget L2)))
)(setq D1 (/ (distance P1 P3) 2)
D2 (/ (distance P2 P4) 2)
)(setq A1 (angle P1 P3)
A2 (angle P2 P4)
)(setq P5 (polar P1 A1 D1)
P6 (polar P2 A2 D2)
)
(command "LINE" P5 P6 "")
)
If you don't mind a routine that draws an Xline [which you would then presumably want to Break or Trim somehow], there's a Bisector command in Bisector.lsp here. It will draw an Xline bisecting the angle between any two non-parallel, or centered in the distance between any two parallel, straight things of any kind -- works with Lines, Polyline [of any variety] line segments, Xlines, Rays, pieces of Hatch patterns, Dimension extension lines or linear-Dimension dimension lines, straight Leader segments, straight edges of 3DSolids/Regions, edges of 2DSolids/3Dfaces/Traces/Wipeouts/Image frames/Viewports/Tolerance boxes, or any such things nested in Blocks or Xrefs or nested further than that [e.g. edges of Dimension arrowheads]. It even checks whether what you select is straight and has linearity [e.g. it will reject Polyline arc segments, Circles, Arcs, Splines, Text, etc.].
But if you need to do it more like your approach, I would suggest testing whether the starting end of one selected Line is closer to the start or the end of the other Line. And if you don't mind a suggested simplification, there is a much more concise way to find the midpoints between their endpoints, by "averaging" their locations, eliminating the need for several of your variables.
Try this [minimally tested]:
(defun c:test ()
(setq
L1 (car (entsel "\nSelect the first line: "))
L2 (car (entsel "\nSelect the second line: "))
P1 (cdr (assoc 10 (entget L1)))
P2 (cdr (assoc 11 (entget L1)))
P3 (cdr (assoc 10 (entget L2)))
P4 (cdr (assoc 11 (entget L2)))
); setq
(if (< (distance P1 P4) (distance P1 P3))
(setq ; then -- reverse second-line point locations
P3 (cdr (assoc 11 (entget L2)))
P4 (cdr (assoc 10 (entget L2)))
); setq
); if
(command
"LINE"
"_none" (mapcar '/ (mapcar '+ P1 P3) '(2 2 2))
"_none" (mapcar '/ (mapcar '+ P2 P4) '(2 2 2))
""
); command
); defun
[EDIT: -- added the "_none" Osnap calls, just in case; you could instead turn Osnap off as part of the routine.]
Try this ...
(defun c:MidLine (/ _Mid l1 l2 pt1 pt2 pt3 pt4) ;;; Tharwat 15. Feb. 2013 ;;; (defun _Mid (p1 p2) (mapcar '(lambda (j k) (/ (+ j k) 2.)) p1 p2) ) (if (and (setq l1 (car (entsel "\n Select the first line: "))) (if (not (eq (cdr (assoc 0 (entget l1))) "LINE")) (progn (princ "\n Your first selection is not a LINE <!>") nil ) t ) (setq l2 (car (entsel "\nSelect the second line: "))) (if (not (eq (cdr (assoc 0 (entget l2))) "LINE")) (progn (princ "\n Your Second selection is not a LINE <!>") nil ) t ) ) (progn (setq pt1 (cdr (assoc 10 (entget l1))) pt2 (cdr (assoc 11 (entget l1))) pt3 (cdr (assoc 10 (entget l2))) pt4 (cdr (assoc 11 (entget l2))) ) (if (inters pt1 pt3 pt2 pt4) (setq pt3 (cdr (assoc 11 (entget l2))) pt4 (cdr (assoc 10 (entget l2))) ) ) (entmakex (list '(0 . "LINE") (cons 10 (_Mid pt1 pt3)) (cons 11 (_Mid pt2 pt4)) ) ) ) (princ) ) (princ) )
For fun and to give you something to think about 🙂
(defun c:l2 (/ mid lines p) (setq mid (lambda (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))) (while (and (setq lines (ssget '((0 . "LINE")))) (= (sslength lines) 2)) (setq p (mapcar '(lambda (i) (list (cdr (Assoc 10 i)) (cdr (assoc 11 i)))) (list (entget (ssname lines 0)) (entget (ssname lines 1))))) (setq p (if (inters (caar p) (caadr p) (cadar p) (cadadr p)) (list (car p)(reverse (cadr p))) p)) (entmakex (list '(0 . "LINE") (cons 10 (mid (caar p)(caadr p))) (cons 11 (mid (cadar p)(cadadr p)))))) (princ) )
smaher12,
just one more way
(defun c:test (/ l1 l2 p1 p2 p3 p4) (setq l1 (car (entsel "\nSelect the first line: ")) l2 (car (entsel "\nSelect the second line: ")) p1 (cdr (assoc 10 (entget l1))) p2 (cdr (assoc 11 (entget l1))) p3 (cdr (assoc 10 (entget l2))) p4 (cdr (assoc 11 (entget l2))) );; setq (if (inters (list (car p1) (cadr p1)) (list (car p3) (cadr p3)) (list (car p2) (cadr p2)) (list (car p4) (cadr p4)) );; inters (vl-cmdf "line" "m2p" p1 p4 "m2p" p2 p3 "") (vl-cmdf "line" "m2p" p1 p3 "m2p" p2 p4 "") );; if ); test
@Tharwat
@pbejse
if the lines are 3D lines the inters function, will not find the interception, because,
in inters, if the four points arguments are 3D, inters checks for 3D intersection...
Henrique
@hmsilva wrote:
if the lines are 3D lines the inters function, will not find the interception, because,
in inters, if the four points arguments are 3D, inters checks for 3D intersection...
Henrique
Good point
(defun c:l2 (/ mid _nonz lines p) (setq mid (lambda (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))) (setq _nonz (lambda (l)(list (car l)(cadr l)))) (while (and (setq lines (ssget '((0 . "LINE")))) (= (sslength lines) 2)) (setq p (mapcar '(lambda (i) (list (cdr (Assoc 10 i)) (cdr (assoc 11 i)))) (list (entget (ssname lines 0)) (entget (ssname lines 1))))) (setq p (if ((lambda (ls) (apply 'inters (list (car ls) (caddr ls) (cadr ls) (cadddr ls)))) (mapcar '_nonz (append (car p)(cadr p)))) (list (car p)(reverse (cadr p))) p)) (entmakex (list '(0 . "LINE") (cons 10 (mid (caar p)(caadr p))) (cons 11 (mid (cadar p)(cadadr p)))))) (princ) )
Another one.
It is user's responsibility to choose the correct part of lines.
(like in Trim, Extend, Fillet etc)
(defun C:TEST (/ s1 s2 l1 l2 pts) (if (and ; - add here error trap for no selection or for entity type (setq s1 (entsel "\nSelect first line: ")) (setq s2 (entsel "\nSelect second line: ")) ) (progn (setq l1 (get_points s1) l2 (get_points s2) pts (mapcar 'mid l1 l2) ) (entmake (list '(0 . "LINE") ;;; (cons 8 "Layer") (cons 10 (car pts)) (cons 11 (cadr pts)) ) ) ) ) (princ) ) (defun get_points (s / e p p1 p2) (setq e (car s) p (vlax-curve-getClosestPointTo e (cadr s)) p1 (vlax-curve-getStartPoint e) p2 (vlax-curve-getEndPoint e) ) (if (< (distance p p1) (distance p p2)) (list p1 p2) (list p2 p1) ) ) (defun mid (p1 p2) (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2) )
If you can stand another approach [I kept daydreaming about it -- is there something wrong with me?]....
This one uses an undocumented (ssget) mode trick [the +.] that I think I learned from Lee Mac a while back, which keeps (ssget) in "point" mode [no going into Window/Crossing if picked in an empty area], making it easy to have it keep asking the User to select a Line until they actually do, without having to dig into entity data to check -- it asks again if they miss or if they pick some other object type. And by using the (set) function, it can employ the same stretch of code to do this for both Lines, rather than spelling it out individually for each one as in _Tharwat's code in Message 3. Also, it doesn't re-set any point locations if the Lines run in opposite directions, but simply uses the end of the second Line appropriate to the direction it runs relative to the first Line, right inside the calculations of the endpoints of the new Line. The one thing I wish could be different is that (ssget) always uses the "Select objects: " prompt, in the plural, which you can't override, so I made a sort-of work-around, mostly so you can tell when you've successfully picked a first Line, because it's asking for Line 2.
(defun C:LB (/ ss lin ed s1 e1 s2 e2 int); = Line Between
(prompt "\nTo draw a Line halfway between two Lines,")
(foreach num '(1 2)
(prompt (strcat "\nFor Line " (itoa num) ","))
(while
(not (setq ss (ssget "_+.:E:S" '((0 . "LINE")))))
(prompt (strcat "\nNothing selected, or not a Line. For Line " (itoa num) ","))
); while
(setq lin (ssname ss 0)); [line]
(setq ed (entget lin)); [entity data]
(set (read (strcat "s" (itoa num))) (cdr (assoc 10 ed))); s1 or s2 [start]
(set (read (strcat "e" (itoa num))) (cdr (assoc 11 ed))); e1 or e2 [end]
); foreach
(setq int (inters s1 s2 e1 e2)); T or nil -- opposite directions [assumes same plane]
(entmake
(list
'(0 . "LINE")
(cons 10 (mapcar '/ (mapcar '+ s1 (if int e2 s2)) '(2 2 2)))
(cons 11 (mapcar '/ (mapcar '+ e1 (if int s2 e2)) '(2 2 2)))
); list
); entmake
); defun
Kent1Cooper wrothe:
...
This one uses an undocumented (ssget) mode trick [the +.] that I think I learned from Lee Mac a while back, which keeps (ssget) in "point" mode [no going into Window/Crossing if picked in an empty area], making it easy to have it keep asking the User to select a Line until they actually do, without having to dig into entity data to check -- it asks again if they miss or if they pick some other object type.
...
The one thing I wish could be different is that (ssget) always uses the "Select objects: " prompt, in the plural, which you can't override, so I made a sort-of work-around, mostly so you can tell when you've successfully picked a first Line, because it's asking for Line 2.
...
Excellent way to use the "ssget", and be able to use a message during selection.
hmsilva wrothe:
...
@Tharwat
if the lines are 3D lines the inters function, will not find the interception, because,
in inters, if the four points arguments are 3D, inters checks for 3D intersection...
as I had written in message 5, the "inters" function gives an error if the points are 3D points...
EDITED
image of the test with the last code.
Henrique
@hmsilva wrote:....
as I had written in message 5, the "inters" function gives an error if the points are 3D points...
....
Yes, that's why I put [assumes same plane] in there -- I was focusing on other elements. [It's not that (inters) gives an error, but just that it returns nil, so the routine assumes the Lines are running in the same direction when they are not, and it averages the locations between the wrong ends of the selected Lines.] But this takes care of that, in limited testing, using a slightly different approach [(defun) rather than (setq)] to pbejse's _nonz function. [And I'm putting it in a code window this time because of the colon-followed-by-S element, so it won't be a smiley for those who don't have those turned off.] Also, it works without the :E I had in the (ssget) mode before.
(defun C:LB (/ noZ ss lin ed s1 e1 s2 e2 int); = Line Between (defun noZ (pt) (list (car pt) (cadr pt))) (prompt "\nTo draw a Line halfway between two Lines,") (foreach num '(1 2) (prompt (strcat "\nFor Line " (itoa num) ",")) (while (not (setq ss (ssget "_+.:S" '((0 . "LINE"))))) (prompt (strcat "\nNothing selected, or not a Line. For Line " (itoa num) ",")) ); while (setq lin (ssname ss 0)); [line] (setq ed (entget lin)); [entity data] (set (read (strcat "s" (itoa num))) (cdr (assoc 10 ed))); s1 or s2 [start] (set (read (strcat "e" (itoa num))) (cdr (assoc 11 ed))); e1 or e2 [end] ); foreach (setq int (inters (noZ s1) (noZ s2) (noZ e1) (noZ e2))); T or nil -- opposite directions (entmake (list '(0 . "LINE") (cons 10 (mapcar '/ (mapcar '+ s1 (if int e2 s2)) '(2 2 2))) (cons 11 (mapcar '/ (mapcar '+ e1 (if int s2 e2)) '(2 2 2))) ); list ); entmake ); defun
Kent Cooper,
the mistake was mine, only after having placed the post, I read the [assumes same plane], my apologies.
One more thing, when I wrote, gives error, in relation to the "inters" function, what I meant was that the function looks for a true intersection if are given 3D points, as this case is just to test the direction the lines were created, gives error not finding the intersection, so to use the "inters" function, in this case, we have to provide 2D points.
Henrique
@hmsilva wrote:.... the function looks for a true intersection if are given 3D points, as this case is just to test the direction the lines were created, gives error not finding the intersection, so to use the "inters" function, in this case, we have to provide 2D points.
....
It would, of course, work with 3D points, if they're all in a common plane. I considered forcing them to be like that by including a Z component of 0 in each point for the (inters) test, that is, in place of doing this:
(defun noZ (pt) (list (car pt) (cadr pt)))
doing this instead:
(defun Z0 (pt) (list (car pt) (cadr pt) 0))
But I found that the X & Y components are enough, so I left it that way.
Then I played around and found some interesting things. If I did a series of them, and then typed U, it undid everything back to the previous regular AutoCAD command [in this instance, the APPLOAD that brought in the command definition], meaning it took away all of the halfway-between Lines I had made, together. So I added undo beginning and ending within the routine, so you can undo one at a time. And because of that, I added error handling to make sure the undo ending happens, in case something goes wrong or you cancel it [e.g. hit Esc when it's asking for the second Line], so you won't be left with an undo beginning that doesn't have an ending.
I also found that it doesn't work quite as expected under some circumstances with Lines that intersect or if one overlaps their apparent/virtual intersection. But I let that stand, because it could be impossible for the routine to determine what "should" be the expected result in a lot of situations. See notes at the top of the attached.
@hmsilva wrote:Kent Cooper,
as usual, a very good code!
Henrique
Thank you. I will sometimes "go all the way" like that with something if I think we'll have a use for it around here. This one, maybe we won't have all that much use for, but we'll see -- just knowing it's available may reveal that a situation like that arises more often than I think.
@Kent1Cooper wrote:If you can stand another approach [I kept daydreaming about it -- is there something wrong with me?]....
I do that myself sometimes
Kent1Cooper wrote:
If you can stand another approach [I kept daydreaming about it -- is there something wrong with me?]....
I was just thinking, what if you wanted to include polylines???
Can't find what you're looking for? Ask the community or share your knowledge.