### Author Topic: Create alignment  (Read 4851 times)

0 Members and 1 Guest are viewing this topic.

#### Fabricio28

• Swamp Rat
• Posts: 663 ##### Create alignment
« on: June 25, 2016, 09:24:45 AM »
Hi guys! How are you?

I'm working in a project that I have create alignments.
But there are alignments that I have to do some autocad commands to get my goal.

steps:
1-create a line from the center
2-create a line perpendicular to the center line.
3-move that perpendicular line to the intersection
4-rotate the group from the center to make a better alignment.
5-trim the lines

i'd like to know if there is a easier way to do that, or maybe a lisp could help me. ##### Re: Create alignment
« Reply #1 on: June 25, 2016, 10:59:30 AM »
If you don't need visual checking it's possible to automate this, but your picture is showing that you interactively choose where perpendicular line finish rotation...

Automation :
1. pick point at the blue arc where your perpendicular line finish rotation (recommended using (vlax-curve-getclosestpointto) function)
2. calculate vector of tangent in the picked point (use (vlax-curve-getfirstderiv) function)
3. create temporary RAY entity from picked point DXF 10 and DXF 11 (unit vector of tangent in that point from 2.)
4. create list of points of intersection of RAY and all other entities...
5. remove picked point from list of intersection points...
6. sort list of intersection points by smallest parameter of RAY entity (use (vl-sort) function in combination with (lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))
7. finally create (entmake) LINE entity from picked point to first point from list of intersection points previously sorted...
8. (entdel ray)
Marko Ribar, d.i.a. (graduated engineer of architecture) #### Fabricio28

• Swamp Rat
• Posts: 663 ##### Re: Create alignment
« Reply #2 on: June 25, 2016, 12:37:35 PM »
Thank for replay ribarm,

Maybe if is possible to create  a polyline  perpendicular to center arc.
It is gonna be good.

And I rotate the line manually.

Thanks

#### ronjonp ##### Re: Create alignment
« Reply #3 on: June 29, 2016, 03:21:39 PM »
Try this:

Code - Auto/Visual Lisp: [Select]
1. (defun c:foo (/ a e e2 i line p)
2.   (if (and (setq e (entsel "\nPick arc at point to start line: "))
3.            (= "ARC" (cdr (assoc 0 (entget (car e)))))
4.            (setq p (vlax-curve-getclosestpointto (car e) (cadr e)))
5.            (setq e (car e))
6.            (setq a (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
7.            (setq e2 (car (entsel "\nPick circle: ")))
8.            (= "CIRCLE" (cdr (assoc 0 (entget e2))))
9.       )
10.     (progn (if (and (setq line (entmakex (list '(0 . "line")
11.                                                (cons 8 (cdr (assoc 8 (entget e))))
12.                                                (cons 10 p)
13.                                                (cons 11 (polar p a 1.))
14.                                          )
15.                                )
16.                     )
17.                     (setq int (vlax-invoke (vlax-ename->vla-object line)
18.                                            'intersectwith
19.                                            (vlax-ename->vla-object e2)
20.                                            acextendthisentity
21.                               )
22.                     )
23.                )
24.              (progn (while int
25.                       (setq i   (cons (list (car int) (cadr int) (caddr int)) i)
26.                             int (cdddr int)
27.                       )
28.                     )
29.                     (setq int (car (vl-sort i '(lambda (a b) (< (distance p a) (distance p b))))))
30.                     (entmod (subst (cons 11 int) (assoc 11 (entget line)) (entget line)))
31.              )
32.              (and line (entdel line))
33.            )
34.     )
35.   )
36.   (princ)
37. )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

#### PKENEWELL ##### Re: Create alignment
« Reply #4 on: June 29, 2016, 04:02:37 PM »
Try this:

Code - Auto/Visual Lisp: [Select]
1. (defun c:foo (/ a e e2 i line p)
2.   (if (and (setq e (entsel "\nPick arc at point to start line: "))
3.            (= "ARC" (cdr (assoc 0 (entget (car e)))))
4.            (setq p (vlax-curve-getclosestpointto (car e) (cadr e)))
5.            (setq e (car e))
6.            (setq a (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
7.            (setq e2 (car (entsel "\nPick circle: ")))
8.            (= "CIRCLE" (cdr (assoc 0 (entget e2))))
9.       )
10.     (progn (if (and (setq line (entmakex (list '(0 . "line")
11.                                                (cons 8 (cdr (assoc 8 (entget e))))
12.                                                (cons 10 p)
13.                                                (cons 11 (polar p a 1.))
14.                                          )
15.                                )
16.                     )
17.                     (setq int (vlax-invoke (vlax-ename->vla-object line)
18.                                            'intersectwith
19.                                            (vlax-ename->vla-object e2)
20.                                            acextendthisentity
21.                               )
22.                     )
23.                )
24.              (progn (while int
25.                       (setq i   (cons (list (car int) (cadr int) (caddr int)) i)
26.                             int (cdddr int)
27.                       )
28.                     )
29.                     (setq int (car (vl-sort i '(lambda (a b) (< (distance p a) (distance p b))))))
30.                     (entmod (subst (cons 11 int) (assoc 11 (entget line)) (entget line)))
31.              )
32.              (and line (entdel line))
33.            )
34.     )
35.   )
36.   (princ)
37. )

Ronjonp,

I haven't tested your code, but doesn't:
Code: [Select]
`(setq p (vlax-curve-getclosestpointto (car e) (cadr e)))`
need to be:

Code: [Select]
`(setq p (vlax-curve-getclosestpointto (vlax-ename->vla-object (car e)) (cadr e)))`?
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

#### Fabricio28

• Swamp Rat
• Posts: 663 ##### Re: Create alignment
« Reply #5 on: June 29, 2016, 04:20:42 PM »
Try this:

Code - Auto/Visual Lisp: [Select]
1. (defun c:foo (/ a e e2 i line p)
2.   (if (and (setq e (entsel "\nPick arc at point to start line: "))
3.            (= "ARC" (cdr (assoc 0 (entget (car e)))))
4.            (setq p (vlax-curve-getclosestpointto (car e) (cadr e)))
5.            (setq e (car e))
6.            (setq a (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
7.            (setq e2 (car (entsel "\nPick circle: ")))
8.            (= "CIRCLE" (cdr (assoc 0 (entget e2))))
9.       )
10.     (progn (if (and (setq line (entmakex (list '(0 . "line")
11.                                                (cons 8 (cdr (assoc 8 (entget e))))
12.                                                (cons 10 p)
13.                                                (cons 11 (polar p a 1.))
14.                                          )
15.                                )
16.                     )
17.                     (setq int (vlax-invoke (vlax-ename->vla-object line)
18.                                            'intersectwith
19.                                            (vlax-ename->vla-object e2)
20.                                            acextendthisentity
21.                               )
22.                     )
23.                )
24.              (progn (while int
25.                       (setq i   (cons (list (car int) (cadr int) (caddr int)) i)
26.                             int (cdddr int)
27.                       )
28.                     )
29.                     (setq int (car (vl-sort i '(lambda (a b) (< (distance p a) (distance p b))))))
30.                     (entmod (subst (cons 11 int) (assoc 11 (entget line)) (entget line)))
31.              )
32.              (and line (entdel line))
33.            )
34.     )
35.   )
36.   (princ)
37. )

Great Ron!!

Worked like a charm

Thanks ##### Re: Create alignment
« Reply #6 on: June 29, 2016, 04:29:11 PM »
I haven't tested your code, but doesn't:
Code: [Select]
`(setq p (vlax-curve-getclosestpointto (car e) (cadr e)))`
need to be:

Code: [Select]
`(setq p (vlax-curve-getclosestpointto (vlax-ename->vla-object (car e)) (cadr e)))`

Contrary to the documentation, the vlax-curve-* functions will perform successfully (and more efficiently) with an entity name argument. #### PKENEWELL ##### Re: Create alignment
« Reply #7 on: June 29, 2016, 04:36:30 PM »
I haven't tested your code, but doesn't:
Code: [Select]
`(setq p (vlax-curve-getclosestpointto (car e) (cadr e)))`
need to be:

Code: [Select]
`(setq p (vlax-curve-getclosestpointto (vlax-ename->vla-object (car e)) (cadr e)))`

Contrary to the documentation, the vlax-curve-* functions will perform successfully (and more efficiently) with an entity name argument. Oh Cool. I learn something new everyday! Thanks for the info Lee "When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt ##### Re: Create alignment
« Reply #8 on: June 29, 2016, 05:56:25 PM »
Just for fun Code - Auto/Visual Lisp: [Select]
1. (defun c:test ( / *error* acn arc ard ccn cir crd grr int pt1 pt2 vec )
2.
3.     (defun *error* ( m ) (redraw) (princ))
4.
5.     (if
6.         (and
7.             (setq arc (LM:selectifobject "\nSelect arc: "    "ARC"   ))
8.             (setq cir (LM:selectifobject "\nSelect circle: " "CIRCLE"))
9.         )
10.             (setq cir (entget cir)
11.                   arc (entget arc)
12.                   ard (cdr (assoc 40 arc))
13.                   crd (cdr (assoc 40 cir))
14.                   acn (trans (cdr (assoc 10 arc)) (cdr (assoc 210 arc)) 1)
15.                   ccn (trans (cdr (assoc 10 cir)) (cdr (assoc 210 cir)) 1)
16.             )
17.             (while (= 5 (car (setq grr (grread t 13 0))))
18.                 (redraw)
19.                 (if (setq pt1 (cadr grr)
20.                           pt2 (polar acn (angle acn pt1) ard)
21.                           vec (mapcar '- pt2 pt1)
22.                           int (LM:inters-line-circle pt2 (mapcar '+ pt2 (list (- (cadr vec)) (car vec))) ccn crd)
23.                           int (car (vl-sort int '(lambda ( a b ) (< (distance pt2 a) (distance pt2 b)))))
24.                     )
25.                     (grdraw pt2 int 2)
26.                 )
27.                 (grdraw acn pt2 8)
28.                 (grdraw pt2 pt1 9 1)
29.             )
30.             (if (and (= 3 (car grr)) int)
31.                 (entmake (list '(0 . "LINE") (cons 10 (trans pt2 1 0)) (cons 11 (trans int 1 0))))
32.             )
33.         )
34.     )
35.     (redraw) (princ)
36. )
37.
38. ;; Select if Object  -  Lee Mac
39. ;; Continuously prompts the user for a selection of a specific object type
40.
41. (defun LM:selectifobject ( msg typ / ent )
42.         (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
43.             (cond
44.                 (   (= 7 (getvar 'errno))
45.                     (princ "\nMissed, try again.")
46.                 )
47.                 (   (null ent) nil)
48.                 (   (not (wcmatch (cdr (assoc 0 (entget ent))) typ))
49.                     (princ "\nInvalid object selected.")
50.                 )
51.             )
52.         )
53.     )
54.     ent
55. )
56.
57. ;; Line-Circle Intersection (vector version)  -  Lee Mac
58. ;; Returns the point(s) of intersection between an infinite line defined by
59. ;; points p,q and circle with centre c and radius r
60.
61. (defun LM:inters-line-circle ( p q c r / v s )
62.     (setq v (mapcar '- q p)
63.           s (mapcar '- p c)
64.     )
65.     (mapcar '(lambda ( s ) (mapcar '+ p (vxs v s)))
66.         (quad (vxv v v) (* 2 (vxv v s)) (- (vxv s s) (* r r)))
67.     )
68. )
69.
70. ;; Quadratic Solution  -  Lee Mac
71. ;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
72.
73. (defun quad ( a b c / d r )
74.     (cond
75.         (   (equal 0.0 (setq d (- (* b b) (* 4.0 a c))) 1e-8)
76.             (list (/ b (* -2.0 a)))
77.         )
78.         (   (< 0 d)
79.             (setq r (sqrt d))
80.             (list (/ (- r b) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
81.         )
82.     )
83. )
84.
85. ;; Vector x Scalar  -  Lee Mac
86. ;; Args: v - vector in R^n, s - real scalar
87.
88. (defun vxs ( v s )
89.     (mapcar '(lambda ( n ) (* n s)) v)
90. )
91.
92. ;; Vector Dot Product  -  Lee Mac
93. ;; Args: u,v - vectors in R^n
94.
95. (defun vxv ( u v )
96.     (apply '+ (mapcar '* u v))
97. )
98.

#### ronjonp ##### Re: Create alignment
« Reply #9 on: June 30, 2016, 08:42:33 AM »
Cool stuff Lee Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC ##### Re: Create alignment
« Reply #10 on: June 30, 2016, 01:56:16 PM »
Cool stuff Lee Cheers Ron - same to you #### alanjt ##### Re: Create alignment
« Reply #11 on: July 05, 2016, 02:11:06 PM »
I'm not discounting the posted code, but couldn't you just draw a line using tan osnap on arc and circle?

eg.
Code: [Select]
`(command "_.line" "_tan" pause "_tan" pause "")`
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

#### BlackBox ##### Re: Create alignment
« Reply #12 on: July 06, 2016, 01:09:21 AM »
FILLET would work as well, no?

Also, I've been working with Civil 3D for so long that I just recently saw the PLINE command properly maintains tangency when a linear segment precedes an arc segment without requiring second point (mid) be specified.

Does vanilla AutoCAD have the Curve from end of object Command?

Cheers
"How we think determines what we do, and what we do determines what we get."

#### ronjonp ##### Re: Create alignment
« Reply #13 on: July 06, 2016, 08:51:22 AM »
I'm not discounting the posted code, but couldn't you just draw a line using tan osnap on arc and circle?

eg.
Code: [Select]
`(command "_.line" "_tan" pause "_tan" pause "")`
This would produce the same result (command "_.line" "_tan" pause "_nea" pause "") .. I guess I used a sledgehammer to kill a flea .

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

#### alanjt ##### Re: Create alignment
« Reply #14 on: July 06, 2016, 09:18:04 AM »
I'm not discounting the posted code, but couldn't you just draw a line using tan osnap on arc and circle?

eg.
Code: [Select]
`(command "_.line" "_tan" pause "_tan" pause "")`
This would produce the same result (command "_.line" "_tan" pause "_nea" pause "") .. I guess I used a sledgehammer to kill a flea .
That's part of the fun. Civil 3D 2019 ~ Windohz 7 64bit
Dropbox