(defun c:test (/ lastLine lastLine1 arc)
(vl-load-com)
(defun makeLine (pt1 pt2)
(redraw
(entmakex (list (cons 0 "LINE")
(cons 10 pt1)
(cons 11 pt2)
) ;_ >list
) ;_ >entmakex
1
) ;_ >redraw
(vlax-ename->vla-object (entlast))
) ;_ >defun
(setvar "FILLETRAD" 5) ;radius
(setq lastLine0 (makeLine
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >makeLine
) ;_ >setq
(while (= (car (setq grr (grread t 0))) 5)
(if lastLine1
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list lastLine1)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
(setq lastLine1 nil)
) ;_ >if
) ;_ >if
(if arc
(progn
(entdel arc)
(setq arc nil)
) ;_ >progn
) ;_ >if
(redraw)
(setq ep2 (cadr grr))
(setq lastLine1 (makeLine pt1 ep2))
(if
(vl-cmdf "_.fillet"
(vlax-curve-getPointAtDist lastLine0 1)
(vlax-curve-getPointAtDist lastLine1 1)
) ;_ >vl-cmdf
(redraw (setq arc (entlast)) 1)
(if lastLine1
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list lastLine1)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
(setq lastLine1 nil)
) ;_ >if ;_ >progn
) ;_ >if
) ;_ >if
) ;_ >while
(princ)
) ;_ >defun
What is the benefit of reinventing the wheel by recreating Andrea's function...Learning how to do it yourself :? ? I don't think he's overstepping anything IMO.
Learning how to do it yourself :? ? I don't think he's overstepping anything IMO.
(defun c:test (/ lastLine lastLine1 arc)
(vl-load-com)
(defun makeLine (pt1 pt2)
(redraw
(entmakex (list (cons 0 "LINE")
(cons 10 pt1)
(cons 11 pt2)
) ;_ >list
) ;_ >entmakex
1
) ;_ >redraw
(vlax-ename->vla-object (entlast))
) ;_ >defun
(setvar 'FILLETRAD 5) ;radius
(setq rad (getvar 'FILLETRAD))
(setq lastLine0 (makeLine
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >makeLine
) ;_ >setq
(while (= (car (setq grr (grread t 0))) 5)
(if lastLine1
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list lastLine1)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
(setq lastLine1 nil)
) ;_ >if
) ;_ >if
(if arc
(progn
(entdel arc)
(setq arc nil)
) ;_ >progn
) ;_ >if
(redraw)
(setq ep2 (cadr grr))
(if (> (distance pt1 ep2) rad)
(progn
(setq pt (polar ep2 (angle ep2 pt1) 1))
(setq lastLine1 (makeLine pt ep2))
(if
(vl-cmdf "_.fillet"
(vlax-curve-getPointAtDist lastLine0 0.5)
(vlax-curve-getPointAtDist lastLine1 0.5)
) ;_ >vl-cmdf
(redraw (setq arc (entlast)) 1)
(if lastLine1
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list lastLine1)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
(setq lastLine1 nil)
) ;_ >if
) ;_ >if
) ;_ >if
) ;_ >progn
) ;_ >if
) ;_ >while
(princ)
) ;_ >defun
I just wanted to learn the first part, which was to do the curvature in real time. Nothing more.
I really apologize for all the embarrassment.
I've lost even the will to learn by thinking that I might be hurting someone's intellectual property.
... have misinterpreted the purpose of a forum like this.
I just wanted to learn the first part, which was to do the curvature in real time. Nothing more.
Nothing wrong with that.I really apologize for all the embarrassment.
Your apology isn't required; I think you're owed one.I've lost even the will to learn by thinking that I might be hurting someone's intellectual property.
Please reconsider. Only one person interpreted your inquiry in a negative light. We all make mistakes, perhaps this was his turn. Forgive him for misinterpreting your intention.... have misinterpreted the purpose of a forum like this.
Not at all. We're all here to learn, even curmudgeons like me who have been doing this twice as long as this forum has existed. Have a great day.
Augusto, Here is a great thread to read to learn about how to use GRREAD
(defun c:test (/ lastLine lastLine1 arc)
(vl-load-com)
;;; FilletMax.LSP [command name: FM]
;;; To FILLET lines and/or lwpolyline line segments, notifying User of MAXimum possible
;;; radius, and asking User to specify a radius (offering current default), before Filleting.
;;; [If a LWPolyline has another segment in the direction beyond the intended filleted end of
;;; the selected segment, and the other object is a Line, can sometimes fail or have unexpected
;;; results, depending on geometry and/or whether the segment beyond is a line or arc,
;;; because Fillet has limitations on what it can do in those situations.]
;;; 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 ang1 ang2 halfang tanang rmax rad)
(setq
int (inters start1 end1 start2 end2 nil) ;intersection of filleted objects [actual or apparent]
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)))
)
;; 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
;; List Collinear-p - Lee Mac
;; Returns T if all points in a list are collinear
(defun LM:ListCollinear-p (lst)
(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
(defun makeLine (pt1 pt2)
(redraw
(entmakex (list (cons 0 "LINE")
(cons 10 pt1)
(cons 11 pt2)
) ;_ >list
) ;_ >entmakex
1
) ;_ >redraw
(vlax-ename->vla-object (entlast))
) ;_ >defun
(defun delLine (line)
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list line)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
) ;_ >if
) ;_ >defun
(defun delArc (arc)
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list (vlax-ename->vla-object arc))
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
)
) ;_ >defun
(setvar 'FILLETRAD 5);radius
(setq rad (getvar 'FILLETRAD))
(setq lastLine0 (makeLine
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >makeLine
) ;_ >setq
(while (= (car (setq grr (grread t 0))) 5)
(redraw)
(setq ep2 (cadr grr))
(setq isCollinear
(LM:ListCollinear-p
(list
(setq startPoint
(vlax-safearray->list
(vlax-variant-value
(vla-get-StartPoint lastLine0)
) ;_ >vlax-variant-value
) ;_ >vlax-safearray->list
) ;_ >setq
(setq endPoint
(vlax-safearray->list
(vlax-variant-value
(vla-get-EndPoint lastLine0)
) ;_ >vlax-variant-value
) ;_ >vlax-safearray->list
) ;_ >setq
ep2
) ;_ >list
) ;_ >LM:ListCollinear-p
) ;_ >setq
(cond
(
isCollinear
(if lastLine1 (delLine lastLine1))
(setq lastLine1 (makeLine endPoint ep2))
)
(
t
(setq pt (polar ep2 (angle ep2 pt1) 1))
(setq radMax
(KC:FM
startPoint
endPoint
(setq pick1 (vlax-curve-getPointAtDist lastLine0 0.9))
pt
ep2
(setq pick2(polar ep2 (angle ep2 pt) 0.9))
rad
) ;_ >KC:FM
) ;_ >setq
(if (> radMax rad)
(progn
(if lastLine1 (delLine lastLine1))
(setq lastLine1 (makeLine pt ep2))
(if arc (delArc arc))
(vl-cmdf "_.fillet"
pick1
pick2
) ;_ >vl-cmdf
(redraw (setq arc (entlast)) 1)
)
) ;_ >if
)
) ;_ >cond
) ;_ >while
(princ)
)
(defun c:test (/ *error* makeLine vx1
vxv KC:FM LM:ListCollinear-p
lastLine0 lastLine1 arc
isCollinear startPoint endPoint
pick1 pick2 pt ep2 rad radMax
) ;_ >/
(vl-load-com)
(defun *error* (errmsg)
(if
(not
(wcmatch errmsg "Function cancelled,quit / exit abort,console break,end")
) ;_ >not
(princ (strcat "\nError: " errmsg))
) ;_ >if
(if oldRad
(setvar 'FILLETRAD oldRad)
) ;_ >if
(if oldSelPrev
(setvar 'SELECTIONPREVIEW oldSelPrev)
) ;_ >if
(if oldNomutt
(setvar 'NOMUTT oldNomutt)
) ;_ >if
(if oldCMD
(setvar 'CMDECHO oldCMD)
) ;_ >if
(princ)
) ;_ >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)
)
tanang (/ (sin halfang) (cos halfang))
)
(setq rmax (min (* leg1 tanang) (* leg2 tanang)))
) ;_ >defun
;; 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
;; List Collinear-p - Lee Mac
;; Returns T if all points in a list are collinear
(defun LM:ListCollinear-p (lst)
(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
(defun makeLine (pt1 pt2)
(redraw
(entmakex (list (cons 0 "LINE")
(cons 10 pt1)
(cons 11 pt2)
) ;_ >list
) ;_ >entmakex
1
) ;_ >redraw
(vlax-ename->vla-object (entlast))
) ;_ >defun
(defun delLine (line)
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list line)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
) ;_ >if
) ;_ >defun
(defun delArc (arc)
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list (vlax-ename->vla-object arc))
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
) ;_ >if
) ;_ >defun
(setq oldRad (getvar 'FILLETRAD)
oldSelPrev (getvar 'SELECTIONPREVIEW)
oldNomutt (getvar 'NOMUTT)
oldCMD (getvar 'CMDECHO)
rad 5
) ;_ >setq
(setvar 'FILLETRAD rad)
(setvar 'SELECTIONPREVIEW 0)
(setvar 'NOMUTT 0)
(setvar 'CMDECHO 0)
(setq lastLine0 (makeLine
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >makeLine
) ;_ >setq
(while (= (car (setq grr (grread t 0))) 5)
(redraw)
(setq ep2 (cadr grr))
(setq isCollinear
(LM:ListCollinear-p
(list
(setq startPoint
(vlax-safearray->list
(vlax-variant-value
(vla-get-StartPoint lastLine0)
) ;_ >vlax-variant-value
) ;_ >vlax-safearray->list
) ;_ >setq
(setq endPoint
(vlax-safearray->list
(vlax-variant-value
(vla-get-EndPoint lastLine0)
) ;_ >vlax-variant-value
) ;_ >vlax-safearray->list
) ;_ >setq
ep2
) ;_ >list
) ;_ >LM:ListCollinear-p
) ;_ >setq
(cond
(
isCollinear
(if lastLine1
(delLine lastLine1)
) ;_ >if
(setq lastLine1 (makeLine endPoint ep2))
)
(
t
(setq pt (polar ep2 (angle ep2 pt1) 1))
(setq pick1 (vlax-curve-getPointAtDist lastLine0 0.1))
(setq pick2 (polar ep2 (angle ep2 pt) 0.1))
(if
(and
startPoint
endPoint
pick1
pt
ep2
pick2
rad
) ;_ >and
(setq radMax
(KC:FM
startPoint
endPoint
pick1
pt
ep2
pick2
rad
) ;_ >KC:FM
) ;_ >setq
) ;_ >if
(if (> radMax rad)
(progn
(if lastLine1
(delLine lastLine1)
) ;_ >if
(setq lastLine1 (makeLine pt ep2))
(if arc
(delArc arc)
) ;_ >if
(vl-cmdf "_.fillet"
pick1
pick2
) ;_ >vl-cmdf
(redraw (setq arc (entlast)) 1)
) ;_ >progn
) ;_ >if
)
) ;_ >cond
) ;_ >while
(*error* "end")
)
I'm almost satisfied with the result.
I would very much like your opinion, after all my goal is learning. :yes:
I miss seeing this forum bustling with great examples of creativity.
An example is the post indicated by PKENEWELL.
;|==============================================================================
Function Name: (pjk-Grread-Fkeys <Character Code>)
Arguments:
kcode = integer; The Character code from the second element in the return from GRREAD.
Returns:
T if ENTER or SPACEBAR is pressed, otherwise NIL
Description:
This function emulates the functions performed when a function key is selected
within a GRREAD loop.
Created by Phil Kenewell 2018
================================================================================|;
(defun pjk-Grread-Fkeys (kcode / ret)
(cond
((= kcode 6) ;; F3
(if (< 0 (getvar "osmode") 16384)
(progn (setvar "osmode" (+ 16384 (getvar "osmode"))) (princ "\n<Osmode off>"))
(progn (setvar "osmode" (- (getvar "osmode") 16384)) (princ "\n<Osmode on>"))
)
)
((= kcode 25) ;; F4
(if (>= (atof (substr (getvar "acadver") 1 4)) 18.1) ;; If AutoCAD 2011 or Higher
(if (= (logand (getvar "3DOSMODE") 1) 1) ;; If 3DOSMODE is off (includes bit code 1)
(progn (setvar "3DOSMODE" (- (getvar "3DOSMODE") 1))(princ "\n<3DOsnap On>"))
(progn (setvar "3DOSMODE" (+ (getvar "3DOSMODE") 1))(princ "\n<3DOsnap Off>"))
)
(progn ;; If older than AutoCAD 2011, toggle Tablet Mode
(setvar "tabmode" (if (= (getvar "tabmode") 1) 0 1))
(princ (strcat "\n<Tablet " (if (= (getvar "tabmode") 1) "on" "off") ">"))
)
)
)
((= kcode 5) ;; F5
(cond
((= (getvar "SNAPISOPAIR") 0)(setvar "SNAPISOPAIR" 1)(princ "\n<Isoplane Top>"))
((= (getvar "SNAPISOPAIR") 1)(setvar "SNAPISOPAIR" 2)(princ "\n<Isoplane Right>"))
((= (getvar "SNAPISOPAIR") 2)(setvar "SNAPISOPAIR" 0)(princ "\n<Isoplane Left>"))
)
)
((= kcode 4) ;; F6
(if (>= (atof (substr (getvar "acadver") 1 4)) 17.0) ;; If AutoCAD 2007 or Higher
(progn
(setvar "UCSDETECT" (if (= (getvar "UCSDETECT") 1) 0 1))
(princ (strcat "\n<Dynamic UCS " (if (= (getvar "UCSDETECT") 1) "on" "off") ">"))
)
(progn ;; If older than AutoCAD 2007, Toggle Coordinate Display
(setvar "COORDS" (if (= (getvar "COORDS") 2) 0 2))
(princ (strcat "\n<Coords " (if (= (getvar "COORDS") 0) "off" "on") ">"))
)
)
)
((= kcode 7) ;; F7
(setvar "gridmode" (if (= (getvar "gridmode") 1) 0 1))
(princ (strcat "\n<Grid " (if (= (getvar "gridmode") 1) "on" "off") ">"))
)
((= kcode 15) ;; F8
(setvar "orthomode" (if (= (getvar "orthomode") 1) 0 1))
(princ (strcat "\n<Ortho " (if (= (getvar "orthomode") 1) "on" "off") ">"))
)
((= kcode 2) ;; F9
(setvar "snapmode" (if (= (getvar "snapmode") 1) 0 1))
(princ (strcat "\n<Snap " (if (= (getvar "snapmode") 1) "on" "off") ">"))
)
((= kcode 21) ;; F10
(if (= (logand (getvar "AUTOSNAP") 8) 8)
(progn (setvar "AUTOSNAP" (- (getvar "AUTOSNAP") 8))(princ "\n<Polar Off>"))
(progn (setvar "AUTOSNAP" (+ (getvar "AUTOSNAP") 8))(princ "\n<Polar On>"))
)
(Princ "\nNOTE: Polar Tracking is not supported in this command.")
)
((= kcode 151) ;; F11
(if (= (logand (getvar "AUTOSNAP") 16) 16)
(progn (setvar "AUTOSNAP" (- (getvar "AUTOSNAP") 16))(princ "\n<Object Snap Tracking off>"))
(progn (setvar "AUTOSNAP" (+ (getvar "AUTOSNAP") 16))(princ "\n<Object Snap Tracking on>"))
)
(Princ "\nNOTE: Object Snap Tracking is not supported in this command.")
)
((= kcode 31) ;; F12
(if (>= (atof (substr (getvar "acadver") 1 4)) 16.2) ;; If AutoCAD 2006 or Higher
(progn
(if (minusp (getvar "DYNMODE"))
(progn (setvar "DYNMODE" (abs (getvar "DYNMODE")))(princ "\n<Dynamic Input on>"))
(progn (setvar "DYNMODE" (- 0 (getvar "DYNMODE")))(princ "\n<Dynamic Input off>"))
)
)
)
)
((vl-position data '(13 32)) ;; Enter or Spacebar
(setq ret T)
)
)
ret
) ;; End Function (pjk-Grread-Fkeys)
it's time to face another difficulty I have, trigonometry.you may find some of them useful
I will skip the ENTMOD function because I understand a little, but the tip was very welcome because it expanded my thinking.
I will try to write the same program using GRVECS only.
It will be quite a challenge.
;|==============================================================================
Function Name: (pjk-GrdrawArc)
Arguments:
cen = 2D/3D point; the center of the arc to draw
p1 = point; The first endpoint of the arc.
p2 = point; The other endpoint of the arc. if NIL, a full circle (polygon) is drawn
color = Integer; the color to draw the vectors, in the same manner as (grvecs)
res = Integer; the resolution (number of points) to draw the arc
Usage: (pjk-GrdrawArc <Center><Endpoint1><Endpoint2><color><resolution>)
Returns: nil - same as (grvecs) function.
Description:
This function draws and arc, circle, or polygon representation using vectors
defined by a center point, a starting/radius point, an endpoint (or nil for
closed shape), an ACI color value, and a resolution value (number of sides).
this can be used in a loop with GRREAD to aproximate an Arc, Circle, or
polygon as needed in real time.
================================================================================|;
(defun pjk-GrdrawArc (cen p1 p2 col res / rd ang1 ang2 anginc grlst)
(setq rd (distance cen p1)
ang1 (angle cen p1)
ang2 (if p2 (angle cen p2)(+ ang1 (* 2.0 pi)))
anginc (/ (pjk-InclAngle ang1 ang2) res)
)
(repeat res
(setq grlst
(if grlst
(append grlst
(list
(last grlst)
(polar cen (setq ang1 (+ ang1 anginc)) rd)
)
)
(list p1 (polar cen (setq ang1 (+ ang1 anginc)) rd))
)
)
)
(grvecs (cons col grlst))
) ;; End Function (pjk-GrdrawArc)
;|==============================================================================
Function Name: (pjk-InclAngle)
Arguments:
sang, eang = real; Start / End angles expressed in radians.
Usage: (pjk-InclAngle <Start Angle> <End Angle>)
Returns:
the included angle between the two angles in radians.
Description:
This function determines the included angle between 2 angles.
================================================================================|;
(defun pjk-InclAngle (sang eang)
(if (> sang eang)
(- (* 2.0 pi) (- sang eang))
(- eang sang)
)
)
;;------------------------------------------------------------------------------
;; Usage: (pjk-pixel->dunits)
;; Description:
;; This Function Returns the Current Size of one Pixel
;; in drawing units.
;;------------------------------------------------------------------------------
(defun pjk-pixel->dunits ()
(/ (getvar "viewsize") (cadr (getvar "screensize")))
) ;; End Function (pjk-pixel->dunits)
;;------------------------------------------------------------------------------
;;Usage: (pjk-dunit->pixels)
;;Description:
;; This function returns the current number of Pixels
;; per one Drawing unit.
;;------------------------------------------------------------------------------
(defun pjk-dunit->pixels ()
(/ (cadr (getvar "screensize")) (getvar "viewsize"))
) ;; End Function (pjk-dunit->pixels)
;|==============================================================================
Function Name: (pjk-GrdrawArrow)
Arguments:
pt = Point; A point to place the end of the Arrow
lgth = Num; The length of the arrow in Pixels
ang = real; an angle expressed in radians
col = int; an ACI color number as accepted by (grvecs)
Usage: (pjk-GrdrawArrow <Point> <Length> <Angle> <Color>)
Returns:
N/A: NIL - same as (grvecs)
Description:
This function draws an arrow using temporary graphics. The size
of the arrow is given in pixels and looks the same on screen regardless
of the zoom factor.
================================================================================|;
(defun pjk-GrdrawArrow (pt lgth ang col / p1 p2 p3 plgth)
(setq plgth (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) lgth)
p1 (polar pt (+ pi ang) plgth)
p2 (polar p1 (+ (/ pi 2) ang) (/ plgth 6))
p3 (polar p1 (+ (* pi 1.5) ang) (/ plgth 6))
col (if col col 300)
)
(grvecs (list col pt p2 p2 p3 p3 pt pt p1))
) ;; End Function (pjk-GrdrawArrow)
;|==============================================================================
Function Name: (pjk-GrdrawPickbox)
Arguments:
pt = Point; A point to draw the pickbox
Usage: (pjk-GrdrawPickbox <Point>)
Returns:
N/A: NIL - same as (grvecs)
Description:
This function imitates the AutoCAD Pickbox using temporary
graphics. Can be useful within a (grread) loop.
================================================================================|;
(defun pjk-GrdrawPickbox (pt / p1 p2 p3 p4 pbox plgth)
(setq pbox (getvar "pickbox")
plgth (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) pbox)
p1 (polar (polar pt (/ pi 2) plgth) 0.0 plgth)
p2 (polar p1 pi (* 2 plgth))
p3 (polar p2 (* pi 1.5) (* 2 plgth))
p4 (polar p3 0.0 (* 2 plgth))
)
(grvecs (list 300 p1 p2 p2 p3 p3 p4 p4 p1))
) ;; End Function (pjk-GrdrawPickbox)
;|==============================================================================
Function Name: (pjk-GrdrawXmark)
Arguments:
pt = Point; A point to draw the X
size = real; a size expressed in pixels
Usage: (pjk-GrdrawXmark <Point> <Size>)
Returns:
N/A: NIL - same as (grvecs)
Description:
This function draws an "X" on the graphics screen using temporary
vectors. The "X" will appear the same size regardless of the zoom
factor.
================================================================================|;
(defun pjk-GrdrawXmark (pt size / p1 p2 p3 p4 plgth)
(setq plgth (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) size)
p1 (polar (polar pt (/ pi 2) (/ plgth 2)) 0.0 (/ plgth 2))
p2 (polar p1 pi plgth)
p3 (polar p2 (* pi 1.5) plgth)
p4 (polar p3 0.0 plgth)
)
(grvecs (list 300 p1 p3 p2 p4))
) ;; End Function (pjk-GrdrawXmark)
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
(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
)
it's time to face another difficulty I have, trigonometry.you may find some of them useful
https://www.theswamp.org/index.php?topic=37319.msg423645#msg423645
(defun c:test (/ pt p1 p2 p3 p4 pt1
pt2 pt3 pt4 oldOSMOD
lastLine0 lastLine1 radius
) ;_ >/
(vl-load-com)
(setq radius 5.0) ;Arc radius
;; Error trap - Beekee CZ
(defun *error* (errmsg)
(if
(not
(wcmatch errmsg
"Function cancelled,quit / exit abort,console break,end"
) ;_ >wcmatch
) ;_ >not
(princ (strcat "\nError: " errmsg))
) ;_ >if
;(if oldOSMOD (setvar 'OSMODE oldOSMOD)) ;_ >if
(princ)
) ;_ >defun
;; Circle Tangents - Lee Mac
(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)
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
) ;_ >defun
(setq lastLine0 (list
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >list
) ;_ >setq
(drawLine lastLine0 1)
(while (member (car (setq grr (grread t 15 0))) '(5 2))
(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 pick1 (polar (nth 1 lastLine0)
(angle (nth 0 lastLine0) (nth 1 lastLine0))
-0.1
) ;_ >polar
) ;_ >setq
(setq pick2 (polar ep2
(angle ep2 (nth 1 lastLine0))
-0.1
) ;_ >polar
) ;_ >setq
(setq radMax
(KC:FM
(nth 0 lastLine0)
(nth 1 lastLine0)
pick1
(nth 1 lastLine0)
ep2
pick2
radius
) ;_ >KC:FM
) ;_ >setq
(if (< radius radMax)
(progn
(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))) radius))
(setq pt1 (polar p1 (setq ang (+ (angle p1 p2) (* 0.5 pi))) radius))
) ;_ >if
(setq pt2 (polar p2 ang radius))
(if (setq isClockwise(LM:Clockwise-p p3 p4 p1))
(setq pt3 (polar p3 (setq ang (- (angle p3 p4) (* 0.5 pi))) radius))
(setq pt3 (polar p3 (setq ang (+ (angle p3 p4) (* 0.5 pi))) radius))
) ;_ >if
(setq pt4 (polar p4 ang radius))
(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)
(setq lst-pt (list p1 p2 p3 p4))
) ;_ >progn
) ;_ >if
)
)
)
) ;_ >cond
) ;_ >while
(princ)
)
I will skip the ENTMOD function because I understand a little, but the tip was very welcome because it expanded my thinking.
I will try to write the same program using GRVECS only.
It will be quite a challenge.
For some examples of using GRVECS, below are some Temporary Graphics function I use within GRREAD loops. Note: You have to use the (redraw) function to clear the temporary graphics at the start of the next loop within (while...), or you get a mess of temporary vectors being drawn as the cursor moves.Code: [Select];|==============================================================================
Function Name: (pjk-GrdrawArc)
Arguments:
cen = 2D/3D point; the center of the arc to draw
p1 = point; The first endpoint of the arc.
p2 = point; The other endpoint of the arc. if NIL, a full circle (polygon) is drawn
color = Integer; the color to draw the vectors, in the same manner as (grvecs)
res = Integer; the resolution (number of points) to draw the arc
Usage: (pjk-GrdrawArc <Center><Endpoint1><Endpoint2><color><resolution>)
Returns: nil - same as (grvecs) function.
Description:
This function draws and arc, circle, or polygon representation using vectors
defined by a center point, a starting/radius point, an endpoint (or nil for
closed shape), an ACI color value, and a resolution value (number of sides).
this can be used in a loop with GRREAD to aproximate an Arc, Circle, or
polygon as needed in real time.
================================================================================|;
(defun pjk-GrdrawArc (cen p1 p2 col res / rd ang1 ang2 anginc grlst)
(setq rd (distance cen p1)
ang1 (angle cen p1)
ang2 (if p2 (angle cen p2)(+ ang1 (* 2.0 pi)))
anginc (/ (pjk-InclAngle ang1 ang2) res)
)
(repeat res
(setq grlst
(if grlst
(append grlst
(list
(last grlst)
(polar cen (setq ang1 (+ ang1 anginc)) rd)
)
)
(list p1 (polar cen (setq ang1 (+ ang1 anginc)) rd))
)
)
)
(grvecs (cons col grlst))
) ;; End Function (pjk-GrdrawArc)
;|==============================================================================
Function Name: (pjk-InclAngle)
Arguments:
sang, eang = real; Start / End angles expressed in radians.
Usage: (pjk-InclAngle <Start Angle> <End Angle>)
Returns:
the included angle between the two angles in radians.
Description:
This function determines the included angle between 2 angles.
================================================================================|;
(defun pjk-InclAngle (sang eang)
(if (> sang eang)
(- (* 2.0 pi) (- sang eang))
(- eang sang)
)
)
;;------------------------------------------------------------------------------
;; Usage: (pjk-pixel->dunits)
;; Description:
;; This Function Returns the Current Size of one Pixel
;; in drawing units.
;;------------------------------------------------------------------------------
(defun pjk-pixel->dunits ()
(/ (getvar "viewsize") (cadr (getvar "screensize")))
) ;; End Function (pjk-pixel->dunits)
;;------------------------------------------------------------------------------
;;Usage: (pjk-dunit->pixels)
;;Description:
;; This function returns the current number of Pixels
;; per one Drawing unit.
;;------------------------------------------------------------------------------
(defun pjk-dunit->pixels ()
(/ (cadr (getvar "screensize")) (getvar "viewsize"))
) ;; End Function (pjk-dunit->pixels)
;|==============================================================================
Function Name: (pjk-GrdrawArrow)
Arguments:
pt = Point; A point to place the end of the Arrow
lgth = Num; The length of the arrow in Pixels
ang = real; an angle expressed in radians
col = int; an ACI color number as accepted by (grvecs)
Usage: (pjk-GrdrawArrow <Point> <Length> <Angle> <Color>)
Returns:
N/A: NIL - same as (grvecs)
Description:
This function draws an arrow using temporary graphics. The size
of the arrow is given in pixels and looks the same on screen regardless
of the zoom factor.
================================================================================|;
(defun pjk-GrdrawArrow (pt lgth ang col / p1 p2 p3 plgth)
(setq plgth (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) lgth)
p1 (polar pt (+ pi ang) plgth)
p2 (polar p1 (+ (/ pi 2) ang) (/ plgth 6))
p3 (polar p1 (+ (* pi 1.5) ang) (/ plgth 6))
col (if col col 300)
)
(grvecs (list col pt p2 p2 p3 p3 pt pt p1))
) ;; End Function (pjk-GrdrawArrow)
;|==============================================================================
Function Name: (pjk-GrdrawPickbox)
Arguments:
pt = Point; A point to draw the pickbox
Usage: (pjk-GrdrawPickbox <Point>)
Returns:
N/A: NIL - same as (grvecs)
Description:
This function imitates the AutoCAD Pickbox using temporary
graphics. Can be useful within a (grread) loop.
================================================================================|;
(defun pjk-GrdrawPickbox (pt / p1 p2 p3 p4 pbox plgth)
(setq pbox (getvar "pickbox")
plgth (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) pbox)
p1 (polar (polar pt (/ pi 2) plgth) 0.0 plgth)
p2 (polar p1 pi (* 2 plgth))
p3 (polar p2 (* pi 1.5) (* 2 plgth))
p4 (polar p3 0.0 (* 2 plgth))
)
(grvecs (list 300 p1 p2 p2 p3 p3 p4 p4 p1))
) ;; End Function (pjk-GrdrawPickbox)
;|==============================================================================
Function Name: (pjk-GrdrawXmark)
Arguments:
pt = Point; A point to draw the X
size = real; a size expressed in pixels
Usage: (pjk-GrdrawXmark <Point> <Size>)
Returns:
N/A: NIL - same as (grvecs)
Description:
This function draws an "X" on the graphics screen using temporary
vectors. The "X" will appear the same size regardless of the zoom
factor.
================================================================================|;
(defun pjk-GrdrawXmark (pt size / p1 p2 p3 p4 plgth)
(setq plgth (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) size)
p1 (polar (polar pt (/ pi 2) (/ plgth 2)) 0.0 (/ plgth 2))
p2 (polar p1 pi plgth)
p3 (polar p2 (* pi 1.5) plgth)
p4 (polar p3 0.0 plgth)
)
(grvecs (list 300 p1 p3 p2 p4))
) ;; End Function (pjk-GrdrawXmark)
For some reason I did not see that answer.
Many thanks for the PKENEWELL examples!
Actually, I found the routine interesting.
I just wanted to learn the first part, which was to do the curvature in real time.
Nothing more.
I really apologize for all the embarrassment.
I will leave here my last attempt because I was satisfied.
I'm sure there are more sophisticated ways, calculating and re-creating all objects, but I've lost even the will to learn by thinking that I might be hurting someone's intellectual property.
Probably I should have misinterpreted the purpose of a forum like this.
A good year for everyone.Code: [Select](defun c:test (/ lastLine lastLine1 arc)
(vl-load-com)
(defun makeLine (pt1 pt2)
(redraw
(entmakex (list (cons 0 "LINE")
(cons 10 pt1)
(cons 11 pt2)
) ;_ >list
) ;_ >entmakex
1
) ;_ >redraw
(vlax-ename->vla-object (entlast))
) ;_ >defun
(setvar 'FILLETRAD 5) ;radius
(setq rad (getvar 'FILLETRAD))
(setq lastLine0 (makeLine
(setq pt1 (getpoint))
(setq pt1 (getpoint pt1))
) ;_ >makeLine
) ;_ >setq
(while (= (car (setq grr (grread t 0))) 5)
(if lastLine1
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list lastLine1)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
(setq lastLine1 nil)
) ;_ >if
) ;_ >if
(if arc
(progn
(entdel arc)
(setq arc nil)
) ;_ >progn
) ;_ >if
(redraw)
(setq ep2 (cadr grr))
(if (> (distance pt1 ep2) rad)
(progn
(setq pt (polar ep2 (angle ep2 pt1) 1))
(setq lastLine1 (makeLine pt ep2))
(if
(vl-cmdf "_.fillet"
(vlax-curve-getPointAtDist lastLine0 0.5)
(vlax-curve-getPointAtDist lastLine1 0.5)
) ;_ >vl-cmdf
(redraw (setq arc (entlast)) 1)
(if lastLine1
(if
(vl-catch-all-error-p
(setq err
(vl-catch-all-apply
'vla-delete
(list lastLine1)
) ;_ >vl-catch-all-apply
) ;_ >setq
) ;_ >vl-catch-all-error-p
(princ (strcat "\n** Error: "
(vl-catch-all-error-message err)
" **"
) ;_ >strcat
) ;_ >princ
(setq lastLine1 nil)
) ;_ >if
) ;_ >if
) ;_ >if
) ;_ >progn
) ;_ >if
) ;_ >while
(princ)
) ;_ >defun
I think you are fine and in fact, I am grateful, as I would love to incorporate this feature into my own routine that creates callout boxes.