77077 Posted May 17, 2017 Share Posted May 17, 2017 Dear all . Choose 2 line (maybe 2 segment of pline) , Horizontal line or Angle line Input ”number of bisector" Draw bisector line Any Suggest ? Sorry for my English , Mybe need some geometry shapes or codes .... Quote Link to comment Share on other sites More sharing options...
lrm Posted May 18, 2017 Share Posted May 18, 2017 You could do it with a special LISP program or use AutoCAD's parametric features. Here's an approach using parametrics. The angle between the white lines is ANG1. The angle between the right most white line and the next red line to the left is ANG2=ANG1/3. The 3 can be changed to other numbers as needed. The other dimensions are set = ANG2. Here ANG2 = ANG1/4 YoU could do something similar for horizontal lines. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 18, 2017 Share Posted May 18, 2017 For two lines I would use this approach note the angle difference, manually I just joined the ends then did a divide 3 then just drew lines snapping using node. A lisp could do the same I expect its already out there. Quote Link to comment Share on other sites More sharing options...
77077 Posted May 18, 2017 Author Share Posted May 18, 2017 You could do it with a special LISP program or use AutoCAD's parametric features. Here's an approach using parametrics. The angle between the white lines is ANG1. The angle between the right most white line and the next red line to the left is ANG2=ANG1/3. The 3 can be changed to other numbers as needed. The other dimensions are set = ANG2. [ATTACH=CONFIG]61326[/ATTACH] [ATTACH=CONFIG]61325[/ATTACH] Here ANG2 = ANG1/4 [ATTACH=CONFIG]61327[/ATTACH] YoU could do something similar for horizontal lines. Dear lrm But Low version no parametrics Quote Link to comment Share on other sites More sharing options...
lrm Posted May 18, 2017 Share Posted May 18, 2017 BIGAL, the method you outline does not divide the angle into 3 equal parts. Here's an example of the results using your method. In fact, this is an impossible task to do using geometry construction techniques. https://en.wikipedia.org/wiki/Angle_trisection The user can dimension the angle between the two lines, divide the value by 3 then use that angle to construct the trisecting lines. Quote Link to comment Share on other sites More sharing options...
BKT Posted May 18, 2017 Share Posted May 18, 2017 You could draw an arc, then use DIVIDE on it. Might take a bit of work in LISP... Quote Link to comment Share on other sites More sharing options...
lrm Posted May 18, 2017 Share Posted May 18, 2017 BKT, that will work. Good job! Quote Link to comment Share on other sites More sharing options...
BKT Posted May 18, 2017 Share Posted May 18, 2017 Thanks, Irm! Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 19, 2017 Share Posted May 19, 2017 Lrm I was looking at the parallel lines not the angle question, it was obvious to me that two non parallel lines would be the next question with equal spacing on ends. Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 19, 2017 Share Posted May 19, 2017 (edited) Interesting project, Updated with some error trapping [b][color=BLACK]([/color][/b]defun c:bisect [b][color=FUCHSIA]([/color][/b]/ e1 ss e2 d1 p10 p11 d2 p20 p21 tl p30 p31 a ad q a1 s1 p1 a2 s2 p2 vp sa ea ia i an[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]defun gc:clockwise-p [b][color=NAVY]([/color][/b]p1 p2 p3[b][color=NAVY])[/color][/b] [color=#8b4513];;;GILE[/color] [b][color=NAVY]([/color][/b]< [b][color=MAROON]([/color][/b]sin [b][color=GREEN]([/color][/b]- [b][color=BLUE]([/color][/b]angle p1 p3[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]angle p1 p2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] -1e-14[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not e1[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nSelect 2 LINEs..."[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 0 [color=#2f4f4f]"LINE"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b] 2[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq e1 [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b] e2 [b][color=GREEN]([/color][/b]ssname ss 1[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]redraw e1 3[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]redraw e2 3[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq d1 [b][color=NAVY]([/color][/b]entget e1[b][color=NAVY])[/color][/b] p10 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 10 d1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] p11 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 11 d1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq d2 [b][color=NAVY]([/color][/b]entget e2[b][color=NAVY])[/color][/b] p20 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 10 d2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] p21 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 11 d2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]foreach p '[b][color=NAVY]([/color][/b]p10 p11 p20 p21[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]member [b][color=BLUE]([/color][/b]eval p[b][color=BLUE])[/color][/b] tl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq tl [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]eval p[b][color=BLUE])[/color][/b] tl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]cond [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]length tl[b][color=GREEN])[/color][/b] 2[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]alert [color=#2f4f4f]"Overlaying LINEs Cannot Be Bisected"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]< [b][color=BLUE]([/color][/b]distance p10 p11[b][color=BLUE])[/color][/b] 1e-8[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]< [b][color=BLUE]([/color][/b]distance p20 p21[b][color=BLUE])[/color][/b] 1e-8[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]alert [color=#2f4f4f]"Both LINEs Must Have Length"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]and [b][color=GREEN]([/color][/b]inters p10 p11 p20 p21[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]length tl[b][color=BLUE])[/color][/b] 4[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]alert [color=#2f4f4f]"Crossing LINEs Cannot Be Bisected"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]inters p10 p11 p20 p21 nil[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq a [color=#2f4f4f]"Linear"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]alert [color=#2f4f4f]"Parrellel LINEs Must Be Linear"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]T [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]length tl[b][color=BLUE])[/color][/b] 3[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq ad [color=#2f4f4f]"Angular"[/color][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq ad [color=#2f4f4f]"Linear"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]initget [color=#2f4f4f]"Angular Linear"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq a [b][color=GREEN]([/color][/b]getkword [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"\nBisector Type - Angular/Linear <"[/color] ad [color=#2f4f4f]">: "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]or a [b][color=GREEN]([/color][/b]setq a ad[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]if a [b][color=NAVY]([/color][/b]progn [b][color=MAROON]([/color][/b]initget 7[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq q [b][color=GREEN]([/color][/b]getint [color=#2f4f4f]"\nNumber Of Bisector Lines: "[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]cond [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]= a [color=#2f4f4f]"Linear"[/color][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]if [b][color=RED]([/color][/b]inters p10 p20 p11 p21[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq p30 p21 p31 p20[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq p30 p20 p31 p21[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]setq a1 [b][color=RED]([/color][/b]angle p10 p30[b][color=RED])[/color][/b] s1 [b][color=RED]([/color][/b]/ [b][color=PURPLE]([/color][/b]distance p10 p30[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]+ q 1[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] p1 [b][color=RED]([/color][/b]polar p10 a1 s1[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]setq a2 [b][color=RED]([/color][/b]angle p11 p31[b][color=RED])[/color][/b] s2 [b][color=RED]([/color][/b]/ [b][color=PURPLE]([/color][/b]distance p11 p31[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]+ q 1[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] p2 [b][color=RED]([/color][/b]polar p11 a2 s2[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]grdraw p10 p10 2[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]grdraw p11 p11 3[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]repeat q [b][color=RED]([/color][/b]entmake [b][color=PURPLE]([/color][/b]list [b][color=TEAL]([/color][/b]cons 0 [color=#2f4f4f]"LINE"[/color][b][color=TEAL])[/color][/b][b][color=TEAL]([/color][/b]cons 62 1[b][color=TEAL])[/color][/b][b][color=TEAL]([/color][/b]cons 10 p1[b][color=TEAL])[/color][/b][b][color=TEAL]([/color][/b]cons 11 p2[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq p1 [b][color=PURPLE]([/color][/b]polar p1 a1 s1[b][color=PURPLE])[/color][/b] p2 [b][color=PURPLE]([/color][/b]polar p2 a2 s2[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]= a [color=#2f4f4f]"Angular"[/color][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]cond [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]equal p10 p20 1e-8[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq vp p10 p1 p11 p2 p21[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]equal p10 p21 1e-8[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq vp p10 p1 p11 p2 p20[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]equal p11 p20 1e-8[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq vp p11 p1 p10 p2 p21[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]equal p11 p21 1e-8[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq vp p11 p1 p10 p2 p20[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]T [b][color=PURPLE]([/color][/b]setq vp [b][color=TEAL]([/color][/b]inters p10 p11 p20 p21 nil[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq p1 [b][color=TEAL]([/color][/b]if [b][color=OLIVE]([/color][/b]< [b][color=GRAY]([/color][/b]distance vp p10[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]distance vp p11[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b] p11[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq p2 [b][color=TEAL]([/color][/b]if [b][color=OLIVE]([/color][/b]< [b][color=GRAY]([/color][/b]distance vp p20[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]distance vp p21[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b] p21[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]if [b][color=RED]([/color][/b]gc:clockwise-p p1 vp p2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq sa [b][color=PURPLE]([/color][/b]angle vp p1[b][color=PURPLE])[/color][/b] ea [b][color=PURPLE]([/color][/b]angle vp p2[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq ea [b][color=PURPLE]([/color][/b]angle vp p1[b][color=PURPLE])[/color][/b] sa [b][color=PURPLE]([/color][/b]angle vp p2[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]setq ia [b][color=RED]([/color][/b]if [b][color=PURPLE]([/color][/b]> sa ea[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]+ [b][color=TEAL]([/color][/b]- [b][color=OLIVE]([/color][/b]* 2 pi[b][color=OLIVE])[/color][/b] sa[b][color=TEAL])[/color][/b] ea[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]- ea sa[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] an [b][color=RED]([/color][/b]/ ia [b][color=PURPLE]([/color][/b]1+ q[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] i 1[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]repeat q [b][color=RED]([/color][/b]entmake [b][color=PURPLE]([/color][/b]list [b][color=TEAL]([/color][/b]cons 0 [color=#2f4f4f]"LINE"[/color][b][color=TEAL])[/color][/b][b][color=TEAL]([/color][/b]cons 62 1[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]cons 10 vp[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]cons 11 [b][color=OLIVE]([/color][/b]polar vp [b][color=GRAY]([/color][/b]+ sa [b][color=AQUA]([/color][/b]* an i[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]* 0.5 [b][color=AQUA]([/color][/b]+ [b][color=LIME]([/color][/b]distance vp p2[b][color=LIME])[/color][/b] [b][color=LIME]([/color][/b]distance vp p1[b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq i [b][color=PURPLE]([/color][/b]1+ i[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] Not thoroughly tested, but seemed to do the job You would need to add your preferences to the ( entmake ) calls for layer, linetypes etc -David gc:clockwise-p : credit Gile @ the swamp Edited May 22, 2017 by David Bethel Quote Link to comment Share on other sites More sharing options...
Squirltech Posted May 19, 2017 Share Posted May 19, 2017 One of our developers here made a bisector tool using .net. It works great but you have to do the line selection in a certain order. Quote Link to comment Share on other sites More sharing options...
tombu Posted May 19, 2017 Share Posted May 19, 2017 Interesting project. Not thoroughly tested, but seemed to do the job.You would need to add your preferences to the ( entmake ) calls for layer, linetypes etc -David Nice code,I changed line 35 (setq a (getkword (strcat "\n Bisector Type - Angula /Linear <" ad ">: "))) to (setq a (getkword (strcat "\n Bisector Type - [color="red"][b][[/b][/color]Angula/Linear[color="red"][b]][/b][/color] <" ad ">: "))) just so I could pick selection with my mouse. That's a keeper, Thanks Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 19, 2017 Share Posted May 19, 2017 Nice code,I changed line 35 just so I could pick selection with my mouse. That's a keeper, Thanks Thanks ! I doubt I will ever use it, but it was interesting I don't know when the [] was introduced for a mouse option. It's not available in the releases I use normally. Glad you found it useful ! -David Quote Link to comment Share on other sites More sharing options...
77077 Posted May 22, 2017 Author Share Posted May 22, 2017 Interesting project, code..... Not thoroughly tested, but seemed to do the job You would need to add your preferences to the ( entmake ) calls for layer, linetypes etc -David gc:clockwise-p : credit Gile @ the swamp Nice routine , David I test and I found, can't use for Pline , and if 2 line no Intersection point , can't draw bisect line too. I have an idea. Can calculate the intersection and draw bisect ? Lee's function (LM:intersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2) acextendboth) (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) (reverse rtn) ) Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 22, 2017 Share Posted May 22, 2017 Nice routine , David Thanks I test and I found, can't use for Pline , and if 2 line no Intersection point , can't draw bisect line too. It really wasn't intended for POLYLINEs. Way too many obsticles and error trapping. Parallel lines should always fail in Angular mode As to no intersection ( angular ), the (inters) function can find the intersecting point, but : What if the the two lines forms an XHow to determine which of the four directions / angle is to be bisected I'm sure there would lots of other problems is a scenario like that. -David Quote Link to comment Share on other sites More sharing options...
tombu Posted May 22, 2017 Share Posted May 22, 2017 If someone wanted to modify David's code for polylines this might be a good starting point: http://gilecad.azurewebsites.net/LISP/PolySegments.lsp Years ago I created a lisp for labeling line or polyline segments that copied a polyline, exploded it, selected the line or arc segment with the same point used to select the polyline and saving it's elist, then deleting all the newly created segments. It could also be a starting point attached along with blocks with attributes used to display line and arc features. Dim_Arc.DWG Dim_Line.DWG Line_Label.lsp Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 22, 2017 Share Posted May 22, 2017 Post 10 updated with some error trapping Quote Link to comment Share on other sites More sharing options...
77077 Posted May 22, 2017 Author Share Posted May 22, 2017 If someone wanted to modify David's code for polylines this might be a good starting point: http://gilecad.azurewebsites.net/LISP/PolySegments.lspYears ago I created a lisp for labeling line or polyline segments that copied a polyline, exploded it, selected the line or arc segment with the same point used to select the polyline and saving it's elist, then deleting all the newly created segments. It could also be a starting point attached along with blocks with attributes used to display line and arc features. Hi tombu This routine can support pline. ;;;;;;;;;;;;;BY YJR111 2011-11-19;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:bisect(/ fglst please input others youself 3q vla_e1 vla_e2) (vl-load-com) (SETQ oldosmode(GETVAR "OSMODE" )) (SETQ oldltscale(GETVAR "ltscale" )) (SETQ oldceltscale(GETVAR "celtscale" )) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "ltscale" 1) (setvar "celtscale" 1) (setvar "cecolor" "1") (command "linetype" "s" "center" "") (setq sss(ssadd)) (setq myms(vla-get-modelspace (setq mydoc(vla-get-activedocument(vlax-get-acad-object)))) myss(vla-get-SelectionSets mydoc) myutility(vla-get-utility mydoc) mylayer(vla-get-layers mydoc) mylinetypes(vla-get-linetypes mydoc) ) (initget 6) (if (and(=(type *num_fenge*)'int)*num_fenge*) (setq num_fenge (getint (strcat "\nNumber Of Bisector Lines<" (rtos *num_fenge* 2 0)">"))) (progn (setq num_fenge (getint "\nNumber Of Bisector Lines" )) (if (/=(type num_fenge)'int) (progn (princ"\nNumber type is wrong, please enter the integer!") (setq num_fenge (getint "\nNumber Of Bisector Lines" )) ) ) ) ) (if (not num_fenge) (setq num_fenge *num_fenge*) (setq *num_fenge* num_fenge ) ) (while (and (setq e1 (car(setq nentsel_e1(nentselp"\nChoose first line :")))) (setq e2 (car(setq nentsel_e2(nentselp"\nChoose second line :")))) ) (setq point_e1 (cadr nentsel_e1)) (setq s1 (entget e1)) (setq point_e2 (cadr nentsel_e2)) (setq s2 (entget e2)) (setq vla_e1(vlax-ename->vla-object e1)) (setq vla_e2(vlax-ename->vla-object e2)) (if (<= (length nentsel_e1) 2) (setq point_e1(vlax-curve-getClosestPointTo vla_e1 point_e1 )) ;;OCS<=>WCS (progn (setq vla_ee1 (vlax-ename->vla-object(caar(reverse nentsel_e1))) xsca(vla-get-XScaleFactor vla_ee1) ysca(vla-get-YScaleFactor vla_ee1) zsca(vla-get-ZScaleFactor vla_ee1) rto(vla-get-rotation vla_ee1) insertp(cdr(assoc 10(entget(caar(reverse nentsel_e1))))) ) (setq shuzu1 (caddr nentsel_e1)) (setq variant_shuzu1 (vlax-make-safearray vlax-vbDouble '(0 . 3)'(0 . 3) )) (command "undo" "be" ) (vlax-safearray-fill variant_shuzu1 shuzu1) (vla-transformby vla_e1 variant_shuzu1) (command "undo" "e" ) (setq point_e1(vlax-curve-getClosestPointTo vla_e1 point_e1 )) (command "undo" 1 ) ) ) (if (<= (length nentsel_e2) 2) (setq point_e2(vlax-curve-getClosestPointTo vla_e2 point_e2 )) ;;OCS<=>WCS (progn (setq vla_ee2 (vlax-ename->vla-object(caar(reverse nentsel_e2))) xsca(vla-get-XScaleFactor vla_ee2) ysca(vla-get-YScaleFactor vla_ee2) zsca(vla-get-ZScaleFactor vla_ee2) rto(vla-get-rotation vla_ee2) insertp(cdr(assoc 10(entget(caar(reverse nentsel_e2))))) ) (setq shuzu2 (caddr nentsel_e2)) (setq variant_shuzu2 (vlax-make-safearray vlax-vbDouble '(0 . 3)'(0 . 3) )) (command "undo" "be" ) (vlax-safearray-fill variant_shuzu2 shuzu2) (vla-transformby vla_e2 variant_shuzu2) (command "undo" "e" ) (setq point_e2(vlax-curve-getClosestPointTo vla_e2 point_e2 )) (command "undo" 1 ) ) ) (if (=(vla-get-objectname vla_e1)"AcDbLine" ) (progn (changedxf10<->11 s1) (entupd e1) (setq s1 ss ss nil ) (setq dxf10_e1(cdr (assoc 10 s1)) dxf11_e1(cdr (assoc 11 s1)) ) (setq vla_e1_ang(vla-get-angle vla_e1)) ) ) (if (=(vla-get-objectname vla_e2)"AcDbLine" ) (progn (changedxf10<->11 s2) (entupd e2) (setq s2 ss ss nil) (setq dxf10_e2(cdr (assoc 10 s2)) dxf11_e2(cdr (assoc 11 s2)) ) (setq vla_e2_ang(vla-get-angle vla_e2)) ) ) (if (=(vla-get-objectname vla_e1)"AcDbPolyline" ) (progn (setq pline1_dxf10(vla-get-coordinates vla_e1)) (setq dxf_e1 (vlax-safearray->list(vlax-variant-value pline1_dxf10))) (setq fglst nil) (fgb dxf_e1) (setq dxf10_lst fglst n 0) (if (> (length nentsel_e1) 2) (progn (setq dxf10_lst(mapcar (function(lambda(x)(trans x (caar(reverse nentsel_e1)) 0)))dxf10_lst)) (setq dxf10_lst(mapcar (function(lambda(x)(ocs->wcs x shuzu1)))dxf10_lst)) ) ) (while(< n (length dxf10_lst)) (cond ((< n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth (1+ n) dxf10_lst))) ((= n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth 0 dxf10_lst))) ) (setq point_ee1(vlax-curve-getClosestPointTo (setq vla_e1(vla-addline myms (vlax-3d-point nthn1)(vlax-3d-point nthn2)))point_e1 )) (if (not (and (equal (car point_e1)(car point_ee1) 1e-3) (equal (cadr point_e1)(cadr point_ee1) 1e-3) (equal (caddr point_e1)(caddr point_ee1) 1e-3) ) ) (progn (vla-delete vla_e1) (setq n(1+ n)) ) (progn (setq e1(vlax-vla-object->ename vla_e1)) (setq s1 (entget e1)) (setq sss (ssadd)) (setq sss(ssadd e1 sss )) (setq n (length dxf10_lst)) ) ) ) (if (=(vla-get-objectname vla_e1)"AcDbLine" ) (progn (changedxf10<->11 s1) (setq s1 ss ss nil) (entupd e1) (setq dxf10_e1(cdr (assoc 10 s1)) dxf11_e1(cdr (assoc 11 s1)) ) (setq vla_e1_ang(vla-get-angle vla_e1)) ) ) ) ) (if (=(vla-get-objectname vla_e2)"AcDbPolyline" ) (progn (setq pline2_dxf10(vla-get-coordinates vla_e2)) (setq dxf_e2 (vlax-safearray->list(vlax-variant-value pline2_dxf10))) (setq fglst nil) (fgb dxf_e2) (setq dxf10_lst fglst n 0) (if (> (length nentsel_e2) 2) (progn (setq dxf10_lst(mapcar (function(lambda(x)(trans x (caar(reverse nentsel_e2)) 0)))dxf10_lst)) (setq dxf10_lst(mapcar (function(lambda(x)(ocs->wcs x shuzu2)))dxf10_lst)) ) ) (while(< n (length dxf10_lst)) (cond ((< n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth (1+ n) dxf10_lst))) ((= n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth 0 dxf10_lst))) ) (setq point_ee2(vlax-curve-getClosestPointTo (setq vla_e2(vla-addline myms (vlax-3d-point nthn1)(vlax-3d-point nthn2)))point_e2 )) (if (not (and (equal (car point_e2)(car point_ee2) 1e-3) (equal (cadr point_e2)(cadr point_ee2) 1e-3) (equal (caddr point_e2)(caddr point_ee2) 1e-3) ) ) (progn (vla-delete vla_e2) (setq n(1+ n)) ) (progn (setq e2(vlax-vla-object->ename vla_e2)) (setq s2 (entget e2)) (setq sss(ssadd e2 sss )) (setq n (length dxf10_lst)) ) ) ) (if (=(vla-get-objectname vla_e2)"AcDbLine" ) (progn (changedxf10<->11 s2) (entupd e2) (setq s2 ss ss nil) (setq dxf10_e2(cdr (assoc 10 s2)) dxf11_e2(cdr (assoc 11 s2)) ) (setq vla_e2_ang(vla-get-angle vla_e2)) ) ) ) ) (cond ( (or (EQUAL vla_e1_ang vla_e2_ang 1E-4) (EQUAL (abs(- vla_e1_ang vla_e2_ang )) pi 1e-4) ) (setq n 1) (repeat (1- *num_fenge*) (if (and (=(cdr(assoc 0(entget(car nentsel_e1))))"LINE" ) (=(cdr(assoc 0(entget(car nentsel_e2))))"LINE" ) (/=(last (cadr shuzu1))0) (/=(last (cadr shuzu2))0) (> (length nentsel_e1) 2) (> (length nentsel_e2) 2) ) (progn (command "undo" "be" ) (vlax-safearray-fill variant_shuzu1 shuzu1) (vla-transformby vla_e1 variant_shuzu1) (vlax-safearray-fill variant_shuzu2 shuzu2) (vla-transformby vla_e2 variant_shuzu2) (command "undo" "e" ) (setq point_e1_start(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-startpoint vla_e1 ))))) (setq point_e1_end(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-endpoint vla_e1 ))))) (if (>(cadr point_e1_start)(cadr point_e1_end)) (progn (setq point_e1_start(list (car point_e1_start)(cadr point_e1_end)0.0)) (setq point_e1_end(list (car point_e1_end)(cadr point_e1_start)0.0)) ) ) (setq point_e2_start(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-startpoint vla_e2 ))))) (setq point_e2_end(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-endpoint vla_e2 ))))) (if (>(cadr point_e2_start)(cadr point_e2_end)) (progn (setq point_e2_start(list (car point_e2_start)(cadr point_e2_end)0.0)) (setq point_e2_end(list (car point_e2_end)(cadr point_e2_start)0.0)) ) ) (command "undo" 1 ) (setq myline(vla-addline myms (vlax-3d-point point_e1_start)(vlax-3d-point point_e1_end))) (setq dist_num(/(distance dxf10_e1 dxf10_e2) *num_fenge* )) (vla-move myline (vlax-3d-point point_e1_start) (vlax-3d-point(polar point_e1_start (angle point_e1_start point_e2_start) (* dist_num n)))) ) (progn (setq myline(vla-copy vla_e1)) (setq dist_num(/(distance dxf10_e1 dxf10_e2) *num_fenge* )) (vla-move myline (vlax-3d-point dxf10_e1) (vlax-3d-point(polar dxf10_e1 (angle dxf10_e1 dxf10_e2) (* dist_num n)))) ) ) (setq n (1+ n)) ) (princ (strcat "\nBisect distance is " (rtos dist_num 2 2) )) ) ( (and (/= vla_e1_ang vla_e2_ang) (wcmatch(vla-get-objectname vla_e1)"*Line" ) ) (if (setq inters_e1_e2 (inters dxf10_e1 dxf11_e1 dxf10_e2 dxf11_e2 )) (progn (setq myline1 (vla-addline myms (vlax-3d-point inters_e1_e2) (vlax-3d-point point_e1))) (setq myline1_ang(vla-get-angle myline1)) (setq myline2 (vla-addline myms (vlax-3d-point inters_e1_e2) (vlax-3d-point point_e2))) (setq myline2_ang(vla-get-angle myline2)) (if (or (and(>= myline1_ang pi )(>= myline2_ang pi )) (and(<= myline1_ang pi )(<= myline2_ang pi )) (and (> myline1_ang (/ pi 2))(< myline1_ang myline2_ang)) (and(> myline1_ang myline2_ang)(> (* 1.5 pi) myline1_ang pi )) ) (setq inters_angle (- myline1_ang myline2_ang)) (progn (if (< myline1_ang myline2_ang) (setq inters_angle (- myline1_ang (- myline2_ang (* 2 pi)))) (setq inters_angle (-(- myline1_ang (* 2 pi)) myline2_ang )) ) ) ) (repeat (1- *num_fenge*) (setq angle_num (* -1(/ inters_angle *num_fenge*))) (vla-rotate myline1 (vlax-3d-point inters_e1_e2) angle_num) (setq myline1(vla-copy myline1)) ) (vla-delete myline2) (princ (strcat "\nBisect angle is " (rtos (abs(*(/ angle_num pi)180)) 2 2) )) ) (progn (if (setq inters_e1_e2 (inters dxf10_e1 dxf11_e1 dxf10_e2 dxf11_e2 nil)) (progn (setq inters_e1_angle (angle inters_e1_e2 dxf10_e1)) (setq inters_e2_angle (angle inters_e1_e2 dxf10_e2)) (if (> inters_e1_angle inters_e2_angle) (setq myline(vla-addline myms (vlax-3d-point inters_e1_e2) (vlax-3d-point(polar inters_e1_e2 (setq inters_angle(+(/(- inters_e1_angle inters_e2_angle)2)inters_e2_angle))(vla-get-length vla_e1))))) (setq myline(vla-addline myms (vlax-3d-point inters_e1_e2) (vlax-3d-point(polar inters_e1_e2 (setq inters_angle(+(/(- inters_e2_angle inters_e1_angle)2)inters_e1_angle))(vla-get-length vla_e1))))) ) (vla-move myline (vlax-3d-point inters_e1_e2) (if (>= inters_angle pi ) (vlax-3d-point (polar dxf11_e1 (angle dxf11_e1 dxf11_e2)(/(distance dxf11_e1 dxf11_e2)2))) (vlax-3d-point (polar dxf10_e1 (angle dxf10_e1 dxf10_e2)(/(distance dxf10_e1 dxf10_e2)2))) ) ) ) ) (princ (strcat "\nBisect angle is" (rtos (abs(*(/ (if (> inters_angle pi)(setq inters_angle (- inters_angle (* 1.5 pi) ))inters_angle)pi) 180)) 2 2) )) ) ) ) ) (if (or(=(vla-get-objectname vla_e1)"AcDbCircle" )(=(vla-get-objectname vla_e1)"AcDbArc" )) (progn (setq center (vla-get-center vla_e1) radius (vla-get-radius vla_e1) ) (cond ((=(vla-get-objectname vla_e1)"AcDbArc" ) (setq myline (vla-addline myms center (vla-get-startpoint vla_e1)) angle_total (vla-get-totalangle vla_e1) ) ) (t (setq myline (vla-addline myms center (vlax-3d-point point_e1)) angle_total (* pi 2) ) ) ) (setq n 1) (repeat (1- *num_fenge*) (setq myline(vla-copy myline)) (setq angle_num (/ angle_total *num_fenge*)) (vla-rotate myline center angle_num) (setq n (1+ n)) ) (princ (strcat "\nBisect angle is" (rtos (abs(*(/ angle_num pi)180)) 2 2) )) ) ) (setq n 0) (if (>(sslength sss)0) (repeat (sslength sss) (command "erase" (ssname sss n) "") (setq n(1+ n)) ) ) ) (SETvar "osmode" oldosmode) (SETvar "ltscale" oldltscale) (princ "\n Thanks for use bisect tools, by yjr111") (princ) ) ;;;(setq lst '(20882.6 12429.7 35344.0 12429.7 35344.0 8473.39 20882.6 8473.39)) ;;;(fgb lst) ((20882.6 12429.7)(35344.0 12429.7)(35344.0 8473.39)(20882.6 8473.39)) (defun fgb(lst / fglst1 dxf10 n) (setq n 0 i 0) (repeat (/(length lst)2) (repeat 2 (setq dxf10 (nth n lst)) (setq fglst1 (append fglst1 (list dxf10 ))) (setq n (1+ n)) ) (setq fglst (append fglst (list fglst1 ))) (setq fglst1 nil) (setq i(1+ i)) ) ) (defun changedxf10<->11(s) (cond ((or (> (cadr (cdr(assoc 10 s))) (cadr (cdr(assoc 11 s)))) (and (= (cadr (cdr(assoc 10 s))) (cadr (cdr(assoc 11 s)))) (>(car (cdr(assoc 10 s))) (car (cdr(assoc 11 s)))) ) ) (setq s(subst (cons 12 (cdr(assoc 10 s))) (assoc 10 s) s)) (setq s(subst (cons 10 (cdr(assoc 11 s))) (assoc 11 s) s)) (setq s(subst (cons 11 (cdr(assoc 12 s))) (assoc 12 s) s)) (entmod s) ) ) (setq ss s) ) ;;ocs->wcs (defun ocs->wcs(p1 shuzu ) (setq shuzu_nth0 (nth 0 shuzu) shuzu_nth1 (nth 1 shuzu) shuzu_nth2 (nth 2 shuzu) shuzu_nth3 (nth 3 shuzu)) (setq trans_point (list (+(*(car p1)(car shuzu_nth0))(*(cadr p1)(cadr shuzu_nth0))(*(caddr p1)(caddr shuzu_nth0))(cadddr shuzu_nth0) ) (+(*(car p1)(car shuzu_nth1))(*(cadr p1)(cadr shuzu_nth1))(*(caddr p1)(caddr shuzu_nth1))(cadddr shuzu_nth1) ) (+(*(car p1)(car shuzu_nth2))(*(cadr p1)(cadr shuzu_nth2))(*(caddr p1)(caddr shuzu_nth2))(cadddr shuzu_nth2) ) ) ) (setq point_e trans_point) ) ;;3Dpoint->2Dpoint (defun 3d->2d(p) (setq p (list(car p)(cadr p)0.0)) ) But still have some BUG , eg: no intersection ( angular ) Quote Link to comment Share on other sites More sharing options...
77077 Posted May 23, 2017 Author Share Posted May 23, 2017 Post 10 updated with some error trapping Hi David , In the following two case Still can't draw bisector line I modify your code . Please don't mind. (defun c:bisect ( / ent1 ent2 int e1 ss e2 d1 p10 p11 d2 p20 p21 p30 p31 a ad q a1 s1 p1 a2 s2 p2 vp sa ea ia i ) (if (and (setq ent1 (select_e "LINE" "\n>>>Choose first line : ")) (setq ent2 (select_e "LINE" "\n>>>Choose second line : ")) ) (progn (initget 7) (setq q (getint "\nNumber Of Bisector Lines: ")) (setq e1 (car ent1)) (setq e2 (car ent2)) (redraw e1 3) (redraw e2 3) (setq int(LM:intersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2) acextendboth)) (cond ((= int nil) (setq d1 (entget e1) p10 (cdr (assoc 10 d1)) p11 (cdr (assoc 11 d1)) ) (setq d2 (entget e2) p20 (cdr (assoc 10 d2)) p21 (cdr (assoc 11 d2)) ) (if(inters p10 p20 p11 p21) (setq p30 p21 p31 p20 ) (setq p30 p20 p31 p21 ) ) (setq a1 (angle p10 p30) s1 (/ (distance p10 p30) (+ q 1)) p1 (polar p10 a1 s1) ) (setq a2 (angle p11 p31) s2 (/ (distance p11 p31) (+ q 1)) p2 (polar p11 a2 s2) ) (grdraw p10 p10 2) (grdraw p11 p11 3) (repeat q (entmake (list (cons 0 "LINE") (cons 62 1) (cons 10 p1) (cons 11 p2) ) ) (setq p1 (polar p1 a1 s1) p2 (polar p2 a2 s2) ) ) ) (int (setq ed1 (entget e1)) (setq ed2 (entget e2)) (SETVAR "FILLETRAD" 0) (command "_.fillet" ent1 ent2) (setq d1 (entget e1) p10 (cdr (assoc 10 d1)) p11 (cdr (assoc 11 d1)) ) (setq d2 (entget e2) p20 (cdr (assoc 10 d2)) p21 (cdr (assoc 11 d2)) ) (cond ((equal p10 p20 1e- (setq vp p10 p1 p11 p2 p21)) ((equal p10 p21 1e- (setq vp p10 p1 p11 p2 p20)) ((equal p11 p20 1e- (setq vp p11 p1 p10 p2 p21)) ((equal p11 p21 1e- (setq vp p11 p1 p10 p2 p20)) ) (if(gc:clockwise-p p1 vp p2) (setq sa (angle vp p1) ea (angle vp p2) ) (setq ea (angle vp p1) sa (angle vp p2) ) ) (setq ia (if (> sa ea)(+ (- (* 2 pi) sa) ea)(- ea sa))) (setq a (/ ia (1+ q)) i 1 ) (repeat q (entmake (list (cons 0 "LINE") (cons 62 1) (cons 10 vp) (cons 11 (polar vp (+ sa (* a i)) (distance vp p1))) ) ) (setq i (1+ i)) ) (entmod ed1) (entmod ed2) ) );end_cond );end_progn );end_if (princ) ) (defun gc:clockwise-p ( p1 p2 p3 ) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14) ) (defun select_e ( x msg / e sel) (while (not e) (setq sel (entsel msg)) (cond ((= nul sel) (princ "\n***No object selected. Please try again! ") ) ((/= x (cdr (assoc 0 (entget (car sel))))) (princ "\n***Invalid choice! " ) ) ((= x (cdr (assoc 0 (entget (car sel))))) (setq e sel) ) (t nil ) ) ) ) (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) (reverse rtn) ) Quote Link to comment Share on other sites More sharing options...
77077 Posted May 23, 2017 Author Share Posted May 23, 2017 (edited) Can add check Collinear function , if Collinear , Exit. @Lee Mac Dear Lee I use your LM:ListCollinear-p function , I found A Problem. Why? ;; Collinear-p - Lee Mac ;; Returns T if p1,p2,p3 are collinear (defun LM:Collinear-p ( p1 p2 p3 ) ( (lambda ( a b c ) (or (equal (+ a b) c 1e- (equal (+ b c) a 1e- (equal (+ c a) b 1e- ) ) (distance p1 p2) (distance p2 p3) (distance p1 p3) ) ) ;; Returns T if all point in a list are collinear (defun LM:ListCollinear-p ( lst ) (or (null (cddr lst)) (and (LM:Collinear-p (car lst) (cadr lst) (caddr lst)) (LM:ListCollinear-p (cdr lst)) ) ) ) (setq lst '((4918.51 1699.6 0.0) (4467.33 1357.01 0.0) (4467.33 1357.01 0.0) (5283.96 1253.34 0.0))) (LM:ListCollinear-p lst) Why return “T” ? The four elements in the list are the vertices of the two lines. Must use LM:unique to remove duplicate elements? Edited May 23, 2017 by 77077 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.