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

0 Members and 1 Guest are viewing this topic.

Augusto

  • Newt
  • Posts: 38
How to make a polyline with rounded corners at runtime?
« on: January 24, 2019, 08:57:09 AM »
Hello guys!
First of all I wish a great year for all of this great forum.

A while ago our colleague Andrea developed a very beautiful code.
I was really curious to learn how the first part was done.



I made my initial attempts and made many mistakes.
Could someone show me how a professional would perform such a task?

Thank you.

[Post edited to change the variable "FILLETRAD" to 5]

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 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
« Last Edit: January 24, 2019, 11:30:17 AM by Augusto »

ribarm

  • Water Moccasin
  • Posts: 2069
  • Marko Ribar, architect
Re: How to make a polyline with rounded corners at runtime?
« Reply #1 on: January 24, 2019, 11:30:50 AM »
What is the benefit of reinventing the wheel by recreating Andrea's function... If Andrea wanted to be exposed, he'd probably publish crox.lsp and not crox.vlx... Either way for good hackers *.vlx extension is not a problem and you are teasing someones intellectual property by putting your fingers where they shouldn't be IMHO...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ronjonp

  • Needs a day job
  • Posts: 6912
Re: How to make a polyline with rounded corners at runtime?
« Reply #2 on: January 24, 2019, 11:47:02 AM »
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.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #3 on: January 24, 2019, 11:50:36 AM »
I had not thought of it that way.
I apologize and if possible delete this post for kindness.  :oops:

My goal was just learning.
Anyway, I killed my curiosity in other versions I made here.

Thank you.

MP

  • Seagull
  • Posts: 17333
Re: How to make a polyline with rounded corners at runtime?
« Reply #4 on: January 24, 2019, 11:59:44 AM »
Learning how to do it yourself  :? ? I don't think he's overstepping anything IMO.

x 2

Seemed perfectly harmless, legit inquiry and didn't say anything about hacking fas/vlx.
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

Augusto

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

MP

  • Seagull
  • Posts: 17333
Re: How to make a polyline with rounded corners at runtime?
« Reply #6 on: January 24, 2019, 12:24:18 PM »
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.
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #7 on: January 24, 2019, 12:36:05 PM »
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.

Thank you very much for the words my friend.
I feel relieved now.
I owe everything I learned to this forum and thought that I would never receive any support from here because I did not express myself well.

PKENEWELL

  • Bull Frog
  • Posts: 206
Re: How to make a polyline with rounded corners at runtime?
« Reply #8 on: January 24, 2019, 04:51:04 PM »
Augusto, Here is a great thread to read to learn about how to use GRREAD

https://www.theswamp.org/index.php?topic=12813.0
"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 #9 on: January 24, 2019, 05:30:38 PM »
Augusto, Here is a great thread to read to learn about how to use GRREAD

Thanks for the tip PKENEWELL!

Even though I'm playing alone, I'm still having fun.
Look at my retry.  :-D
By changing SELECTIONPREVIEW to 0 the result becomes more interesting.

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



Augusto

  • Newt
  • Posts: 38
Re: How to make a polyline with rounded corners at runtime?
« Reply #10 on: January 25, 2019, 07:48:17 AM »
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.

Code: [Select]
(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")
)
« Last Edit: January 25, 2019, 08:34:32 AM by Augusto »

PKENEWELL

  • Bull Frog
  • Posts: 206
Re: How to make a polyline with rounded corners at runtime?
« Reply #11 on: January 25, 2019, 12:42:31 PM »
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.

You have a good start Augusto. I would recommend strongly however you learn how to do entity modification using the entity list and ENTMOD, or using VLA-Object modification rather than repeating a command sequence in the GRREAD loop. Your current method is slow and very inefficient. There is also a number of other things that must be emulated in a GRREAD loop to make the program viable to other users, such as object snaps and function keys etc. I'm sorry I currently do not have time to play more with your code and give you an example. Keep learning and experimenting with the code and you will progress.

To give you something to try out: This is a function I created to emulate Function keys while working in a GRREAD loop.
Code: [Select]
;|==============================================================================
  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)
"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 #12 on: January 28, 2019, 08:24:42 AM »
Once again thank you for your patience and for encouraging me PKENEWELL!
This time I decided to overcome my difficulties and face the GRREAD function.
When testing the returns of the function two things caught my attention.
The first surprise was to test the double click on the scroll wheel who returned the set of lists
(2 39)(2 95)(2 46)(2 122)(2 111)(2 111)(2 109)(2 32)(2 95)(2 101)(2 32)
that form the word '_zoom _e and the second was to test the right mouse button and return the code 25 which curiously is not documented.
Once I understood the GRREAD function minimally, it's time to face another difficulty I have, trigonometry.

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.

Thank you to everyone who understood my purpose.
See you.

VovKa

  • Swamp Rat
  • Posts: 1087
  • Ukraine
Re: How to make a polyline with rounded corners at runtime?
« Reply #13 on: January 28, 2019, 09:36:05 AM »
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

PKENEWELL

  • Bull Frog
  • Posts: 206
Re: How to make a polyline with rounded corners at runtime?
« Reply #14 on: January 29, 2019, 10:54:13 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)
"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