Author Topic: Create alignment (Read 4851 times)

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

ribarm · « **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)

Fabricio28 · « **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 · « **Reply #3 on:** June 29, 2016, 03:21:39 PM »

Try this:

Code - Auto/Visual Lisp: [Select]

(defun c:foo (/ a e e2 i line p)
  (if (and (setq e (entsel "\nPick arc at point to start line: "))
           (= "ARC" (cdr (assoc 0 (entget (car e)))))
           (setq p (vlax-curve-getclosestpointto (car e) (cadr e)))
           (setq e (car e))
           (setq a (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
           (setq e2 (car (entsel "\nPick circle: ")))
           (= "CIRCLE" (cdr (assoc 0 (entget e2))))
      )
    (progn (if (and (setq line (entmakex (list '(0 . "line")
                                               (cons 8 (cdr (assoc 8 (entget e))))
                                               (cons 10 p)
                                               (cons 11 (polar p a 1.))
                                         )
                               )
                    )
                    (setq int (vlax-invoke (vlax-ename->vla-object line)
                                           'intersectwith
                                           (vlax-ename->vla-object e2)
                                           acextendthisentity
                              )
                    )
               )
             (progn (while int
                      (setq i   (cons (list (car int) (cadr int) (caddr int)) i)
                            int (cdddr int)
                      )
                    )
                    (setq int (car (vl-sort i '(lambda (a b) (< (distance p a) (distance p b))))))
                    (entmod (subst (cons 11 int) (assoc 11 (entget line)) (entget line)))
             )
             (and line (entdel line))
           )
    )
  )
  (princ)
)

PKENEWELL · « **Reply #4 on:** June 29, 2016, 04:02:37 PM »

Quote from: ronjonp on June 29, 2016, 03:21:39 PM

Try this:

Code - Auto/Visual Lisp: [Select]
(defun c:foo (/ a e e2 i line p)
(if (and (setq e (entsel "\nPick arc at point to start line: "))
(= "ARC" (cdr (assoc 0 (entget (car e)))))
(setq p (vlax-curve-getclosestpointto (car e) (cadr e)))
(setq e (car e))
(setq a (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
(setq e2 (car (entsel "\nPick circle: ")))
(= "CIRCLE" (cdr (assoc 0 (entget e2))))
)
(progn (if (and (setq line (entmakex (list '(0 . "line")
(cons 8 (cdr (assoc 8 (entget e))))
(cons 10 p)
(cons 11 (polar p a 1.))
)
)
)
(setq int (vlax-invoke (vlax-ename->vla-object line)
'intersectwith
(vlax-ename->vla-object e2)
acextendthisentity
)
)
)
(progn (while int
(setq i (cons (list (car int) (cadr int) (caddr int)) i)
int (cdddr int)
)
)
(setq int (car (vl-sort i '(lambda (a b) (< (distance p a) (distance p b))))))
(entmod (subst (cons 11 int) (assoc 11 (entget line)) (entget line)))
)
(and line (entdel line))
)
)
)
(princ)
)

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)))?

Fabricio28 · « **Reply #5 on:** June 29, 2016, 04:20:42 PM »

Quote from: ronjonp on June 29, 2016, 03:21:39 PM

Try this:

Code - Auto/Visual Lisp: [Select]
(defun c:foo (/ a e e2 i line p)
(if (and (setq e (entsel "\nPick arc at point to start line: "))
(= "ARC" (cdr (assoc 0 (entget (car e)))))
(setq p (vlax-curve-getclosestpointto (car e) (cadr e)))
(setq e (car e))
(setq a (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
(setq e2 (car (entsel "\nPick circle: ")))
(= "CIRCLE" (cdr (assoc 0 (entget e2))))
)
(progn (if (and (setq line (entmakex (list '(0 . "line")
(cons 8 (cdr (assoc 8 (entget e))))
(cons 10 p)
(cons 11 (polar p a 1.))
)
)
)
(setq int (vlax-invoke (vlax-ename->vla-object line)
'intersectwith
(vlax-ename->vla-object e2)
acextendthisentity
)
)
)
(progn (while int
(setq i (cons (list (car int) (cadr int) (caddr int)) i)
int (cdddr int)
)
)
(setq int (car (vl-sort i '(lambda (a b) (< (distance p a) (distance p b))))))
(entmod (subst (cons 11 int) (assoc 11 (entget line)) (entget line)))
)
(and line (entdel line))
)
)
)
(princ)
)

Great Ron!!

Worked like a charm

Thanks

Lee Mac · « **Reply #6 on:** June 29, 2016, 04:29:11 PM »

Quote from: PKENEWELL on June 29, 2016, 04:02:37 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 · « **Reply #7 on:** June 29, 2016, 04:36:30 PM »

Quote from: Lee Mac on June 29, 2016, 04:29:11 PM

Quote from: PKENEWELL on June 29, 2016, 04:02:37 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

Lee Mac · « **Reply #8 on:** June 29, 2016, 05:56:25 PM »

Just for fun

Code - Auto/Visual Lisp: [Select]

(defun c:test ( / *error* acn arc ard ccn cir crd grr int pt1 pt2 vec )
 
    (defun *error* ( m ) (redraw) (princ))
 
    (if
        (and
            (setq arc (LM:selectifobject "\nSelect arc: "    "ARC"   ))
            (setq cir (LM:selectifobject "\nSelect circle: " "CIRCLE"))
        )
        (progn
            (setq cir (entget cir)
                  arc (entget arc)
                  ard (cdr (assoc 40 arc))
                  crd (cdr (assoc 40 cir))
                  acn (trans (cdr (assoc 10 arc)) (cdr (assoc 210 arc)) 1)
                  ccn (trans (cdr (assoc 10 cir)) (cdr (assoc 210 cir)) 1)
            )
            (while (= 5 (car (setq grr (grread t 13 0))))
                (redraw)
                (if (setq pt1 (cadr grr)
                          pt2 (polar acn (angle acn pt1) ard)
                          vec (mapcar '- pt2 pt1)
                          int (LM:inters-line-circle pt2 (mapcar '+ pt2 (list (- (cadr vec)) (car vec))) ccn crd)
                          int (car (vl-sort int '(lambda ( a b ) (< (distance pt2 a) (distance pt2 b)))))
                    )
                    (grdraw pt2 int 2)
                )
                (grdraw acn pt2 8)
                (grdraw pt2 pt1 9 1)
            )
            (if (and (= 3 (car grr)) int)
                (entmake (list '(0 . "LINE") (cons 10 (trans pt2 1 0)) (cons 11 (trans int 1 0))))
            )
        )
    )
    (redraw) (princ)
)
 
;; Select if Object  -  Lee Mac
;; Continuously prompts the user for a selection of a specific object type
 
(defun LM:selectifobject ( msg typ / ent )
    (while
        (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (not (wcmatch (cdr (assoc 0 (entget ent))) typ))
                    (princ "\nInvalid object selected.")
                )
            )
        )
    )
    ent
)
 
;; Line-Circle Intersection (vector version)  -  Lee Mac
;; Returns the point(s) of intersection between an infinite line defined by
;; points p,q and circle with centre c and radius r
 
(defun LM:inters-line-circle ( p q c r / v s )
    (setq v (mapcar '- q p)
          s (mapcar '- p c)
    )
    (mapcar '(lambda ( s ) (mapcar '+ p (vxs v s)))
        (quad (vxv v v) (* 2 (vxv v s)) (- (vxv s s) (* r r)))
    )
)
 
;; Quadratic Solution  -  Lee Mac
;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
 
(defun quad ( a b c / d r )
    (cond
        (   (equal 0.0 (setq d (- (* b b) (* 4.0 a c))) 1e-8)
            (list (/ b (* -2.0 a)))
        )
        (   (< 0 d)
            (setq r (sqrt d))
            (list (/ (- r b) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
        )
    )
)
 
;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar
 
(defun vxs ( v s )
    (mapcar '(lambda ( n ) (* n s)) v)
)
 
;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n
 
(defun vxv ( u v )
    (apply '+ (mapcar '* u v))
)
 
(princ)

ronjonp · « **Reply #9 on:** June 30, 2016, 08:42:33 AM »

Cool stuff Lee

Lee Mac · « **Reply #10 on:** June 30, 2016, 01:56:16 PM »

Quote from: ronjonp on June 30, 2016, 08:42:33 AM

Cool stuff Lee

Cheers Ron - same to you

alanjt · « **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 "")

BlackBox · « **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

ronjonp · « **Reply #13 on:** July 06, 2016, 08:51:22 AM »

Quote from: 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 "")

This would produce the same result (command "_.line" "_tan" pause "_nea" pause "") .. I guess I used a sledgehammer to kill a flea

.

alanjt · « **Reply #14 on:** July 06, 2016, 09:18:04 AM »

Quote from: ronjonp on July 06, 2016, 08:51:22 AM

Quote from: 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 "")
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.

News:

Author Topic: Create alignment (Read 4851 times)

Fabricio28

Create alignment

ribarm

Re: Create alignment

Fabricio28

Re: Create alignment

ronjonp

Re: Create alignment

PKENEWELL

Re: Create alignment

Fabricio28

Re: Create alignment

Lee Mac

Re: Create alignment

PKENEWELL

Re: Create alignment

Lee Mac

Re: Create alignment

ronjonp

Re: Create alignment

Lee Mac

Re: Create alignment

alanjt

Re: Create alignment

BlackBox

Re: Create alignment

ronjonp

Re: Create alignment

alanjt

Re: Create alignment