Author Topic: How to make a polyline with rounded corners at runtime?  (Read 1236 times)

0 Members and 1 Guest are viewing this topic.

PKENEWELL

  • Bull Frog
  • Posts: 206
"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

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #16 on: January 29, 2019, 01:54:11 PM »
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.

Code: [Select]
(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

)

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #17 on: January 29, 2019, 02:06:33 PM »
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

These programs are certainly very useful and interesting!
At the moment I have not found a way to use them, but I will certainly use them in the future.
Many thanks for the suggestion VovKa!

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #18 on: January 30, 2019, 12:33:51 PM »
This was the last version I made so far.
Unfortunately at this point I'm running out of time to continue my exploration.
Feel free to modify it.
When I have time in the future I'll play with him again.
Thank you all for contributing my learning.  :-)

Augusto

Code: [Select]
(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)
)

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #19 on: January 31, 2019, 07:05:12 AM »
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!

PKENEWELL

  • Bull Frog
  • Posts: 206
Re: How to make a polyline with rounded corners at runtime?
« Reply #20 on: January 31, 2019, 04:16:06 PM »
For some reason I did not see that answer.
Many thanks for the PKENEWELL examples!

I'm glad that you found them useful Augusto  :-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

cmwade77

  • Swamp Rat
  • Posts: 1192
Re: How to make a polyline with rounded corners at runtime?
« Reply #21 on: February 04, 2019, 07:28:19 PM »
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.

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #22 on: February 05, 2019, 05:37:10 AM »
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.

Many thanks for the encouragement cmwade77!
I'm very happy that you have found a purpose for this piece of code. Feel free to use it and modify it.
Cheers