Also Look at the following from Lee Mac:
http://www.lee-mac.com/orthopoint.html
http://www.lee-mac.com/grsnap.html
http://www.lee-mac.com/grtext.html
Many thanks for the suggestions PKENEWELL!
I will try to implement in the future.
See my first version using GRDRAW only.
I'm happy with this evolution.
Soon I will bring the improved code.
(defun c:test (/ pt p1 p2 p3 p4 pt1
pt2 pt3 pt4 dwgobj
oldOSMOD lastLine0
lastLine1
) ;_ >/
(vl-load-com)
(defun *error* (errmsg)
(if
(not
(wcmatch errmsg
"Function cancelled,quit / exit abort,console break,end"
) ;_ >wcmatch
) ;_ >not
(princ (strcat "\nError: " errmsg))
) ;_ >if
(vla-endundomark dwgobj)
(if oldOSMOD
(setvar 'OSMODE oldOSMOD)
) ;_ >if
(princ)
) ;_ >defun
;; Circle Tangents
;; Author: Lee Mac, Copyright © 2014 - www.lee-mac.com
(defun grarc (cen pt1 pt2 / ang rad)
(setq ctan:res 100 ;; arc resolution (int > 0)
ctan:2pi (+ pi pi)
ctan:inc (/ ctan:2pi ctan:res)
) ;_ >setq
(setq ang (angle cen pt1)
rad (distance cen pt1)
) ;_ >setq
(repeat (fix (/ (rem (+ (- (angle cen pt2) ang) ctan:2pi) ctan:2pi)
ctan:inc
) ;_ >/
) ;_ >fix
(grdraw pt1
(setq pt1 (polar cen (setq ang (+ ang ctan:inc)) rad))
1
) ;_ >grdraw
) ;_ >repeat
(grdraw pt1 pt2 1)
) ;_ >defun
;; Clockwise-p - Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented
(defun LM:Clockwise-p (p1 p2 p3)
((lambda (n) (< (car (trans p2 0 n)) (car (trans p1 0 n))))
(mapcar '- p1 p3)
)
) ;_ >defun
;; Project Point onto Line - Lee Mac
;; Projects pt onto the line defined by p1,p2
(defun LM:ProjectPointToLine (pt p1 p2 / nm)
(setq nm (mapcar '- p2 p1)
p1 (trans p1 0 nm)
pt (trans pt 0 nm)
) ;_ >setq
(trans (list (car p1) (cadr p1) (caddr pt)) nm 0)
) ;_ >defun
;; List Collinear-p - Lee Mac
;; Returns T if all points in a list are collinear
(defun LM:ListCollinear-p (lst)
;; Unit Vector - Lee Mac
;; Args: v - vector in R^2 or R^3
(defun vx1 (v)
((lambda (n)
(if (equal 0.0 n 1e-10)
nil
(mapcar '/ v (list n n n))
) ;_ >if
) ;_ >lambda
(distance '(0.0 0.0 0.0) v)
)
) ;_ >defun
;; Vector Dot Product - Lee Mac
;; Args: u,v - vectors in R^n
(defun vxv (u v)
(apply '+ (mapcar '* u v))
) ;_ >defun
(or (null (cddr lst))
(and
(equal 1.0
(abs
(vxv
(vx1 (mapcar '- (car lst) (cadr lst)))
(vx1 (mapcar '- (car lst) (caddr lst)))
) ;_ >vxv
) ;_ >abs
1e-8
) ;_ >equal
(LM:ListCollinear-p (cdr lst))
) ;_ >and
) ;_ >or
) ;_ >defun
;; Kent Cooper, last edited 18 March 2015
;; http://cadtips.cadalyst.com/2d-editing/fix-fillet-radius-too-large
(defun KC:FM (start1 end1 pick1 start2 end2 pick2 rTest /
int farend1 farend2 leg1 leg2 ang1ang2
halfang tanang rmaxrad
)
(setq int (inters start1 end1 start2 end2 nil)
farend1 (if
(equal (angle pick1 int) (angle pick1 start1) 0.001)
end1
start1
) ;_ >if
farend2 (if
(equal (angle pick2 int) (angle pick2 start2) 0.001)
end2
start2
) ;_ >if
leg1 (distance int farend1)
leg2 (distance int farend2)
ang1 (angle int farend1)
ang2 (angle int farend2)
halfang (if (< (abs (- ang1 ang2)) pi)
(/ (abs (- ang1 ang2)) 2)
(/ (- (* pi 2) (abs (- ang1 ang2))) 2)
) ;_ >if
tanang (/ (sin halfang) (cos halfang))
) ;_ >setq
(setq rmax (min (* leg1 tanang) (* leg2 tanang)))
) ;_ >defun
(defun drawLine (lst col)
(grdraw (nth 0 lst)
(nth 1 lst)
col
) ;_ >grdraw
)
(setq lastLine0 (list
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >list
) ;_ >setq
(drawLine lastLine0 1)
(while (= (car (setq grr (grread t 0))) 5)
(setq ep2 (cadr grr))
(setq isCollinear
(LM:ListCollinear-p
(list
(setq startPoint (nth 0 lastLine0))
(setq endPoint (nth 1 lastLine0))
ep2
) ;_ >list
) ;_ >LM:ListCollinear-p
) ;_ >setq
(cond
(isCollinear
(redraw)
(drawLine lastLine0 1)
(setq lastLine1 (list
endPoint
ep2
) ;_ >list
) ;_ >setq
(drawLine lastLine1 1)
)
(t
(setq lastLine1 (list
endPoint
ep2
) ;_ >list
) ;_ >setq
(setq p1 (nth 0 lastLine0)
p2 (nth 1 lastLine0)
p3 (nth 0 lastLine1)
p4 (nth 1 lastLine1)
) ;_ >setq
(if (LM:Clockwise-p p1 p2 p4)
(setq pt1 (polar p1 (setq ang (- (angle p1 p2) (* 0.5 pi))) 1.0))
(setq pt1 (polar p1 (setq ang (+ (angle p1 p2) (* 0.5 pi))) 1.0))
) ;_ >if
(setq pt2 (polar p2 ang 1.0))
(if (setq isClockwise(LM:Clockwise-p p3 p4 p1))
(setq pt3 (polar p3 (setq ang (- (angle p3 p4) (* 0.5 pi))) 1.0))
(setq pt3 (polar p3 (setq ang (+ (angle p3 p4) (* 0.5 pi))) 1.0))
) ;_ >if
(setq pt4 (polar p4 ang 1.0))
(setq pt (inters pt1 pt2 pt3 pt4))
(redraw)
(if (/= pt nil)
(progn
(if isClockwise
(grarc
pt
(setq p3(LM:ProjectPointToLine pt p3 p4))
(setq p2(LM:ProjectPointToLine pt p1 p2))
) ;_ >grarc
(grarc
pt
(setq p2(LM:ProjectPointToLine pt p1 p2))
(setq p3(LM:ProjectPointToLine pt p3 p4))
) ;_ >grarc
) ;_ >if
(drawLine (list p1 p2) 1)
(drawLine (list p3 p4) 1)
) ;_ >progn
) ;_ >if
)
) ;_ >cond
) ;_ >while
)