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

0 Members and 1 Guest are viewing this topic.

PKENEWELL

  • Bull Frog
  • Posts: 309
"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: 75
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: 75
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: 75
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: 75
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: 309
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: 1443
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: 75
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

ahsattarian

  • Newt
  • Posts: 112
Re: How to make a polyline with rounded corners at runtime?
« Reply #23 on: December 15, 2020, 05:10:18 AM »
This will help U :



Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (defun sub1 () (cond (pl1 (entdel pl1) (setq pl1 nil))) (cond (pl2 (entdel pl2) (setq pl2 nil))))
  3.   (defun sub2 ()
  4.     (redraw)
  5.     (command "pline")
  6.     (foreach po li (command po))
  7.     (cond ((listp pt) (command pt)))
  8.     (command "")
  9.     (setq pl1 (entlast))
  10.     (command "chprop" "last" "" "color" 251 "") ;| #chprop |;
  11.     (command "pline")
  12.     (foreach po li (command po))
  13.     (cond ((listp pt) (command pt)))
  14.     (command "")
  15.     (setq pl2 (entlast))
  16.     (command "fillet" "polyline" pl2)
  17.   )
  18.   (setvar "osmode" 0)
  19.   (setvar "autosnap" 39)
  20.   (setvar "orthomode" 0)
  21.   (cond ((= (getvar "filletrad") 0.0) (setvar "filletrad" 1.0)))
  22.   (setq ratio 1.1)
  23.   (setq g 1)
  24.   (while (= g 1) ;| #grread point |;
  25.     (setq gr (grread t 15 0))
  26.     (setq code (car gr))
  27.     (setq po (cadr gr))
  28.     (cond
  29.       ((= code 3) (setq g 0)) ;| Click Beshe |;
  30.       ((= code 2) ;| Type Beshe |;
  31.        (cond
  32.          ((member po '(82 114)) ;|  r R  |;
  33.           (setq tmp (getdist "\n Radius : "))
  34.           (setvar "filletrad" tmp)
  35.           (setq g 1)
  36.          )
  37.          ((= po 43) (setvar "filletrad" (* (getvar "filletrad") ratio))) ;|  +  |;
  38.          ((= po 45) (setvar "filletrad" (/ (getvar "filletrad") ratio))) ;|  -  |;
  39.          (t (exit))
  40.        )
  41.       )
  42.       ((= code 25) (exit)) ;| #mouse #right-click |;
  43.     )
  44.   )
  45.   (setvar "cmdecho" 0)
  46.   (setq li (list po))
  47.   (setq pl1 nil)
  48.   (setq pl2 nil)
  49.   (setq g 1)
  50.   (while (= g 1) ;| #grread point |;
  51.     (setq gr (grread t 15 0))
  52.     (setq code (car gr))
  53.     (setq pt (cadr gr))
  54.     (cond
  55.       ((= code 5) (sub1) (sub2)) ;| Bedune Click |;
  56.       ((= code 3) (sub1) (sub2) (setq li (append li (list pt)))) ;| Click Beshe |;
  57.       ((= code 2) ;| Type Beshe |;
  58.        (cond
  59.          ((member pt '(82 114)) ;|  r R  |;
  60.           (setq tmp (getdist "\n Radius : "))
  61.           (setvar "filletrad" tmp)
  62.           (setq g 1)
  63.          )
  64.          ((= pt 43) (setvar "filletrad" (* (getvar "filletrad") ratio))) ;|  +  |;
  65.          ((= pt 45) (setvar "filletrad" (/ (getvar "filletrad") ratio))) ;|  -  |;
  66.          (t (sub1) (sub2) (setq g 0))
  67.        )
  68.       )
  69.       ((= code 25) (sub1) (sub2) (setq g 0)) ;| #mouse #right-click |;
  70.     )
  71.   )
  72.   (princ)
  73. )






BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: How to make a polyline with rounded corners at runtime?
« Reply #24 on: December 18, 2020, 02:47:33 AM »
Some where have a drag fillet done by Alan JT many years ago similar method just drag the arc part and it changes radius.

Re call out would a dynamic block work as can drag say X & Y but rad will stay fixed. A pretty easy dynamic block as not to many parameters can use rad2=rad1 so only have to update 1 rad variable and all 4 corners will change.
A man who never made a mistake never made anything