TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Fabricio28 on June 25, 2016, 09:24:45 AM

Title: Create alignment
Post by: Fabricio28 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
Title: Re: Create alignment
Post by: ribarm 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)
Title: Re: Create alignment
Post by: Fabricio28 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
Title: Re: Create alignment
Post by: ronjonp 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. )
Title: Re: Create alignment
Post by: PKENEWELL 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)))?
Title: Re: Create alignment
Post by: Fabricio28 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
Title: Re: Create alignment
Post by: Lee Mac 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:
Title: Re: Create alignment
Post by: PKENEWELL 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
Title: Re: Create alignment
Post by: Lee Mac 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.  
Title: Re: Create alignment
Post by: ronjonp on June 30, 2016, 08:42:33 AM
Cool stuff Lee  8)
Title: Re: Create alignment
Post by: Lee Mac on June 30, 2016, 01:56:16 PM
Cool stuff Lee  8)

Cheers Ron - same to you  :-)
Title: Re: Create alignment
Post by: alanjt 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 "")
Title: Re: Create alignment
Post by: BlackBox 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
Title: Re: Create alignment
Post by: ronjonp 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 :) .
Title: Re: Create alignment
Post by: alanjt 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
Title: Re: Create alignment
Post by: squirreldip on July 06, 2016, 12:36:17 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 "")

I read the OP and considering the replies I was thinking I misinterpreted what he was wanting to do.

So many ways to do this and I think basic AutoCAD commands are the best solution.
Title: Re: Create alignment
Post by: ahsattarian on March 17, 2023, 04:16:05 PM


What about setting  OSMODE on  256   ???

Title: Re: Create alignment
Post by: BIGAL on March 17, 2023, 08:26:40 PM
Nearly 7 years old post ?