Topic: Help - Lisp drawing polyline by degree between two parallel

[mihaibantas]

Hello everyone, I am new to the lisp world and this forum. I have huge request if someone can help me with a code.
I want to join two parallel polylines/lines by a polyline/line drawn automatically to a certain degree.

I've attached a dwg / jpg file for example.

Thanks in advance for your time...have a good day

[Dlanor]

Quick mashup. Minimal checking. If required you can change the angle of the lines, but these must be in degrees or decimal degrees.

There is also scope to add the new lines to the red polyline.

Code - Auto/Visual Lisp: [Select]

1. (vl-load-com)
2.  
3. (defun rh:select_ent ( pmt / rtn )
4.   (setq rtn (car (entsel pmt)))
5. );end_defun
6.  
7. (defun rh:D2R (d) (* pi (/ d 180.0)))
8.  
9. (defun rh:draw_line (spc s_pnt e_pnt ang dist / line t_pnt)
10.   (if (and (not ang) (not dist) e_pnt)
11.     (setq line (vla-AddLine spc (vlax-3D-point s_pnt) (vlax-3D-point e_pnt)))
12.     (setq t_pnt (polar s_pnt (rh:D2R ang) dist)
13.           line (vla-AddLine spc (vlax-3D-point s_pnt) (vlax-3D-point t_pnt))
14.     );end_setq
15.   );end_if
16. );end_defun      
17.  
18. (defun rh:intersect_pt (ent1 ent2 / int_pt rtn)
19.   (setq int_pt (vlax-invoke-method ent1 'IntersectWith ent2 acExtendNone))
20.   (if (/= -1 (vlax-safearray-get-u-bound (vlax-variant-value int_pt) 1))
21.     (setq rtn (vlax-safearray->list (vlax-variant-value int_pt)))
22.     (setq rtn nil)
23.   );end_if
24. );end_defun
25.  
26. (defun c:test ( / *error* c_doc ms r_ent g_ent rs_pnt re_pnt left right ans t_line i_pt l_line r_line)
27.  
28.   (defun *error* ( msg )
29.     (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
30.     (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
31.     (princ)
32.   );_end_*error*_defun
33.        
34.   (setq c_doc (vla-get-ActiveDocument (vlax-get-acad-object))
35.         ms (vla-get-modelspace c_doc)
36.         l_ang 214                       ;<<======= Real angle of left line in degrees (180 + required angle)
37.         r_ang 326                       ;<<======= Real angle of right line in degrees (0 - required angle)
38.         r_ent (rh:select_ent "\nSelect Red Polyline : ")
39.         g_ent (rh:select_ent "\nSelect Green Polyline : ")
40.         rs_pnt (vlax-curve-getstartpoint r_ent)
41.         re_pnt (vlax-curve-getendpoint r_ent)
42.   );end_setq
43.  
44.   (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark c_doc))
45.         (vla-startundomark c_doc)
46.  
47.   (if (> (car rs_pnt) (car re_pnt))
48.     (setq left re_pnt
49.           right rs_pnt
50.     );end_setq
51.     (setq left rs_pnt
52.           right re_pnt
53.     );end_setq
54.   );end_if
55.   (initget "Left Right Both")
56.   (setq ans (getkword "\nDraw Connecting Line to End [Left Right Both] : "))  ;<<== Pressing L,P or B upper or lower case will select correctly
57.   (cond ( (= ans "Left")
58.           (setq t_line (rh:draw_line ms left nil l_ang 50))
59.           (setq i_pt (rh:intersect_pt t_line (vlax-ename->vla-object g_ent)))
60.           (vla-delete t_line)
61.           (setq l_line (rh:draw_line ms left i_pt nil nil))
62.         );end_=Left
63.        ( (= ans "Right")
64.           (setq t_line (rh:draw_line ms right nil r_ang 50))
65.           (setq i_pt (rh:intersect_pt t_line (vlax-ename->vla-object g_ent)))
66.           (vla-delete t_line)
67.           (setq r_line (rh:draw_line ms right i_pt nil nil))      
68.         );end_=Right
69.        ( (= ans "Both")
70.           (setq t_line (rh:draw_line ms left nil l_ang 50))
71.           (setq i_pt (rh:intersect_pt t_line (vlax-ename->vla-object g_ent)))
72.           (vla-delete t_line)
73.           (setq l_line (rh:draw_line ms left i_pt nil nil))
74.           (setq t_line (rh:draw_line ms right nil r_ang 50))
75.           (setq i_pt (rh:intersect_pt t_line (vlax-ename->vla-object g_ent)))
76.           (vla-delete t_line)
77.           (setq r_line (rh:draw_line ms right i_pt nil nil))          
78.         );end_=Both
79.   );end_cond
80.   (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark c_doc))
81. );end_defun
82.  
83.  

[mihaibantas]

Hello Dlanor
First of all I want to thank you for your help ... the code works perfectly

It seems like I'm facing another problem .... Can I adjust the code to make the same line type just as the green line is above the red I attached the example in the picture ... Thank you in advance for your time.

[Dlanor]

Yes, you can adjust the hard coded angles in the main defun (defun c:test). The first setq function contains two variables l_ang (left angle) and r_ang (right angle). They have comments

;<<===== alongside them

The angles are in degrees. If you require the same slope angle (34 degrees) change l_ang to 146 and r_ang to 34 for red below green

I'll attempt to alter my routine to account for red below green, but i can't do anything before this evening.

[mihaibantas]

Hello Dlanor....I made the changes in the code ... and they were successful .... but I happen to have both situations in same drawing. What do you suggest me to do ....... to use two different codes with the respective modified variables

Command TEST ======> l_ang to 146 and r_ang to 34
Command TEST1 ======> l_ang to 214 and r_ang to 326.

However wait and modified version of you ... maybe you version much better solution than mine...Thanks again for the interest shown to my problem

[Dlanor]

Edited as attached file superceded

[Dlanor]

Improved Lisp. Type "test" on commandline to run

While loop: Repeats until null selection made for either polyline or enter pressed at same prompt.

Lisp now handles either end of design polyline being on the ground line or intersection point being outside extents of ground line 

Test drawing included to test cases.

 

[mihaibantas]

Thanks again for the last code ... it covers all my related problems
I wish you a good day

[Dlanor]

Thanks again for the last code ... it covers all my related problems

Not a problem, i'm glad it helps

[BIGAL]

If these are road cross sections why are you not producing the batter slope any way

To make the code much simpler pick pline left side compare start and end pts swap if required, Pick connecting pline, the line angle is not an angle rather a slope 1:ratio so draw a ray line and look for intersect pt if not reverse angle this is cut v's fill. You know which is left and right so there is only 2 solutions per end to try. Even old lisp (inters p1 p2 p3 p4) if true then it intersects at the new point, false reverse angle.

30+ years civil design.