Author Topic: Create alignment  (Read 5750 times)

0 Members and 1 Guest are viewing this topic.

Fabricio28

  • Swamp Rat
  • Posts: 670
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.

Thanks in advance

ribarm

  • Gator
  • Posts: 3245
  • Marko Ribar, architect
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)

:)

M.R. on Youtube

Fabricio28

  • Swamp Rat
  • Posts: 670
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

  • Needs a day job
  • Posts: 7527
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

  • Bull Frog
  • Posts: 316
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: 670
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

Lee Mac

  • Seagull
  • Posts: 12910
  • London, England
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.  :wink:

PKENEWELL

  • Bull Frog
  • Posts: 316
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.  :wink:

Oh Cool. I learn something new everyday! Thanks for the info Lee  :-D
"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

Lee Mac

  • Seagull
  • Posts: 12910
  • London, England
Re: Create alignment
« Reply #8 on: June 29, 2016, 05:56:25 PM »
Just for fun  :lol:

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.         (progn
  11.             (setq cir (entget cir)
  12.                   arc (entget arc)
  13.                   ard (cdr (assoc 40 arc))
  14.                   crd (cdr (assoc 40 cir))
  15.                   acn (trans (cdr (assoc 10 arc)) (cdr (assoc 210 arc)) 1)
  16.                   ccn (trans (cdr (assoc 10 cir)) (cdr (assoc 210 cir)) 1)
  17.             )
  18.             (while (= 5 (car (setq grr (grread t 13 0))))
  19.                 (redraw)
  20.                 (if (setq pt1 (cadr grr)
  21.                           pt2 (polar acn (angle acn pt1) ard)
  22.                           vec (mapcar '- pt2 pt1)
  23.                           int (LM:inters-line-circle pt2 (mapcar '+ pt2 (list (- (cadr vec)) (car vec))) ccn crd)
  24.                           int (car (vl-sort int '(lambda ( a b ) (< (distance pt2 a) (distance pt2 b)))))
  25.                     )
  26.                     (grdraw pt2 int 2)
  27.                 )
  28.                 (grdraw acn pt2 8)
  29.                 (grdraw pt2 pt1 9 1)
  30.             )
  31.             (if (and (= 3 (car grr)) int)
  32.                 (entmake (list '(0 . "LINE") (cons 10 (trans pt2 1 0)) (cons 11 (trans int 1 0))))
  33.             )
  34.         )
  35.     )
  36.     (redraw) (princ)
  37. )
  38.  
  39. ;; Select if Object  -  Lee Mac
  40. ;; Continuously prompts the user for a selection of a specific object type
  41.  
  42. (defun LM:selectifobject ( msg typ / ent )
  43.     (while
  44.         (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
  45.             (cond
  46.                 (   (= 7 (getvar 'errno))
  47.                     (princ "\nMissed, try again.")
  48.                 )
  49.                 (   (null ent) nil)
  50.                 (   (not (wcmatch (cdr (assoc 0 (entget ent))) typ))
  51.                     (princ "\nInvalid object selected.")
  52.                 )
  53.             )
  54.         )
  55.     )
  56.     ent
  57. )
  58.  
  59. ;; Line-Circle Intersection (vector version)  -  Lee Mac
  60. ;; Returns the point(s) of intersection between an infinite line defined by
  61. ;; points p,q and circle with centre c and radius r
  62.  
  63. (defun LM:inters-line-circle ( p q c r / v s )
  64.     (setq v (mapcar '- q p)
  65.           s (mapcar '- p c)
  66.     )
  67.     (mapcar '(lambda ( s ) (mapcar '+ p (vxs v s)))
  68.         (quad (vxv v v) (* 2 (vxv v s)) (- (vxv s s) (* r r)))
  69.     )
  70. )
  71.  
  72. ;; Quadratic Solution  -  Lee Mac
  73. ;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
  74.  
  75. (defun quad ( a b c / d r )
  76.     (cond
  77.         (   (equal 0.0 (setq d (- (* b b) (* 4.0 a c))) 1e-8)
  78.             (list (/ b (* -2.0 a)))
  79.         )
  80.         (   (< 0 d)
  81.             (setq r (sqrt d))
  82.             (list (/ (- r b) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
  83.         )
  84.     )
  85. )
  86.  
  87. ;; Vector x Scalar  -  Lee Mac
  88. ;; Args: v - vector in R^n, s - real scalar
  89.  
  90. (defun vxs ( v s )
  91.     (mapcar '(lambda ( n ) (* n s)) v)
  92. )
  93.  
  94. ;; Vector Dot Product  -  Lee Mac
  95. ;; Args: u,v - vectors in R^n
  96.  
  97. (defun vxv ( u v )
  98.     (apply '+ (mapcar '* u v))
  99. )
  100.  

ronjonp

  • Needs a day job
  • Posts: 7527
Re: Create alignment
« Reply #9 on: June 30, 2016, 08:42:33 AM »
Cool stuff Lee  8)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12910
  • London, England
Re: Create alignment
« Reply #10 on: June 30, 2016, 01:56:16 PM »
Cool stuff Lee  8)

Cheers Ron - same to you  :-)

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
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

  • King Gator
  • Posts: 3770
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

  • Needs a day job
  • Posts: 7527
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

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
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. :P
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox