GRRDRAW with ARCS

[Happy Hobbit]

It’s relatively straight forward to code a rectangular GRRDRAW function as below, which draws a rectangle from the middle of one side. Does anyone know if it’s possible to create a GRRDRAW function so that it appears to have an ARC at one or both ends (as picture) without GRRDRAWing lots of small segments (lines) all of which would need coordinates built into the code. I don’t need the code to actually draw the shape, just the GRRDRAW part of it.

 

(defun c:test (/ pt1 pt2 pt3 pt4 pt5 pt6 wid)
 (setq wid (getint "\Width? <10>"))
 (if (= wid nil) (setq wid 10))
   (if  
     (setq pt1 (getpoint "\nSelect 1st point"))
       (progn
         ;(command "circle" pt1 4.0)
         (while 
           (not (= (car (setq pt2 (grread t 15 0))) 3))
           (redraw) 
           (if
             (listp (setq pt2 (cadr pt2)))
             (progn
	(setq pt3 (polar pt1 (* pi 0.5) (* wid 0.5))
	      pt4 (polar pt1 (* pi 1.5) (* wid 0.5))
	      pt5 (polar pt2 (* pi 0.5) (* wid 0.5))
	      pt6 (polar pt2 (* pi 1.5) (* wid 0.5)))
		   (grdraw pt3 pt4 1 3)
		   (grdraw pt3 pt5 1 3)
		   (grdraw pt4 pt6 1 3)
		   (grdraw pt5 pt6 1 3)
             )
           )
         )
       )
   )
 (command "_pline"
   (list (car pt3) (cadr pt3))
   (list (car pt4) (cadr pt4))
   (list (car pt6) (cadr pt6))
   (list (car pt5) (cadr pt5))
   (list (car pt3) (cadr pt3)) "C")
 (redraw)
 (princ)
)

[Stefan BMR]

Try this one

 

;Stefan M. 15.02.2016
(defun C:SLOT ( / p1 w n h e p g r p o enter)
 (defun 2dp (p1 p2 d)
   (reverse (cdr (reverse (trans (polar p1 (+ (angle p1 p2) (/ pi 2)) d) 1 n))))
   )
 (if
   (and
     (setq w (/ (cond ((getdist "\nWidth <10>: ")) (10.0)) 2))
     (setq p1 (getpoint "\nStart point: "))
     )
   (progn
     (setq n (trans '(0 0 1) 1 0 T)
           h (caddr (trans p1 1 n))
           e (entmakex
               (list
                 '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 (cons 38 h)
                 '(90 . 4)
                 '(70 . 1)
                 (cons 10 (2dp p1 p1 (- w)))
                 '(42 . 0)
                 (cons 10 (2dp p1 p1 (- w)))
                 '(42 . 1)
                 (cons 10 (2dp p1 p1 w))
                 '(42 . 0)
                 (cons 10 (2dp p1 p1 w))
                 '(42 . 1)
                 (cons 210 n)
                 )
               )
           o (vlax-ename->vla-object e)
           )
   (grread T)
   (while (not enter)
     (setq g (grread t 15 0)
           r (car  g)
           p (cadr g)
           )
     (cond
       ((or (member r '(11 12 25)) (= p 13) (= p 32)) (entdel e) (setq enter T))
       ((= r 5)
        (vlax-put o 'coordinates
           (append
             (2dp p1 p (- w))
             (2dp p p1 w)
             (2dp p p1 (- w))
             (2dp p1 p w)
             )
           )
        )
       ((= r 3) (setq enter T))
       )
     )
   )
 )
 (princ)
 )

[Happy Hobbit]

Thank you Stefan, that works well. I'm trying to figure out which is the 'preview' part of the code? The entity itself (a slot) is obviously created from the entmakex function, but where exactly is the equivalent of the grrdraw bit?

[Stefan BMR]

It doesn't use grdraw. The polyline's coordinates are updated instead. (vlax-put o 'coordinates...

[Happy Hobbit]

vlax-put is a new one on me. I cannot find much about it online either! It does the job though so thank you again Stefan

[Lee Mac]

Here's an example using grvecs.

 

As the function names suggest, grdraw & grvecs can only create vectors, therefore the arcs are created using multiple line segments.

[Happy Hobbit]

It would however have been nice to just have the grdraw for a shape rather than one which actually draws the shape.

 

**MODERATOR** Please change the title of this thread to 'GRDRAW with ARCS' , makes it easier for people to search. Sorry about the typo

 

Addendum:

Ah, only just noticedyour thread Lee, that code looks quite easy to incorporate into the code in my first post above. Simply replace the first point with a polar function from a defined point, the second point can probably be done the same way....

I think...

[Lee Mac]

Here's another example which may also be of some interest: Circle Tangents.

 

The above includes grarc & grcircle functions and also demonstrates how to implement a form of Object Snap within a grread loop.

[Happy Hobbit]

Aha! Looks perfect Lee. I'd already seen a reference to it under the heading Grsnap but couldn't find the code for the demo!

Thank you very much indeed

[Lee Mac]

You're most welcome!

[Nikon]

Good day everyone!

Lisp Stefan M. (15.02.2016) draws a slot with a given width and binding to the first point.

Someone can add a binding to the second point to this lisp. 
Thank you in advance.

[BIGAL]

Slot.lsp

 

(defun c:slot ( / )
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq pt1 (getpoint "\nPick centre point 1 ")
pt2 (getpoint pt1 "\nPick second centre point ")
)
(setq rad (getreal "\nEnter radius "))
(setq ang (angle pt1 pt2))
(setq dist (distance pt1 pt2))
(command "LIne" pt1 pt2 "")
(setq obj (vlax-ename->vla-object (entlast)))
(vla-offset obj rad)
(setq off (entlast))
(setq pt1 (vlax-curve-getstartPoint off))
(setq pt6 (vlax-curve-getEndPoint off))
(entdel off)
(vla-offset obj (- rad))
(setq off (entlast))
(setq pt3 (vlax-curve-getstartPoint off))
(setq pt4 (vlax-curve-getEndPoint off))
(entdel off)
(setq mp (mapcar '* (mapcar '+ pt1 pt3) '(0.5 0.5)))
(setq pt2 (polar mp (+ ang pi) rad))
(setq mp (mapcar '* (mapcar '+ pt4 pt6) '(0.5 0.5)))
(setq pt5 (polar mp ang rad))
(command "pLINE"  pt1 "w" 0.0 0.0 "arc" "s" pt2 pt3 "L" pt4 "arc" "s" pt5 pt6 "L" "c")
(princ)
)
(c:slot)

 

[Nikon]

BIGAL, thank you, but the slot is not being built, after entering the radius, the line is shifted, the arcs
are not being built.

Edited November 23, 2023 by Nikon

[BIGAL]

Did you pick short points that would cause the arc ends to overlap no check for that. Let me know say distance between points and arc rad. The distance between points needs to be more than 2*rad.

Edited November 23, 2023 by BIGAL

[Nikon]

1. select 1 snap point (arc center)

2. specify the width between straight lines (or the radius of the arc, Arc=W/2)

3. specify the 2nd  snap point
It is desirable that it be a single polyline (closed outline).

Or
if, it's easier.
Create a slot with the specified width (Rar c=W/2)

between the two selected points.

SLOT.dwg

Edited November 24, 2023 by Nikon

[marko_ribar]

Here is my version... But something strange : (entmake) won't work on your provided *.DWG... On new one it works, so for your *.DWG I had to go through command version - "pline" command... Finally I've mod. resulting LWPOLYLINE to have 4 vertices instead of 5 and everything worked well...

 

(defun c:slot ( / *error* cmd p1 p2 hw pp1 pp2 pp3 pp4 enx )

  (defun *error* ( m )
    (while (= 8 (logand 8 (getvar 'undoctl)))
      (if command-s
        (command-s "_.undo" "_end")
        (vl-cmdf "_.undo" "_end")
      )
    )
    (if cmd
      (setvar 'cmdecho cmd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq cmd (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while (= 8 (logand 8 (getvar 'undoctl)))
    (vl-cmdf "_.undo" "_end")
  )
  (vl-cmdf "_.undo" "_begin")
  (initget 1)
  (setq p1 (getpoint "\nPick or specify left point : "))
  (setq p1 (list (car p1) (cadr p1)))
  (initget 1)
  (setq p2 (getpoint p1 "\nPick or specify right point : "))
  (setq p2 (list (car p2) (cadr p2)))
  (initget 7)
  (setq hw (getdist p1 "\nPick or specify half width of slot - radius of curved parts : "))
  (setq pp1 (polar p1 (- (angle p1 p2) (* 0.5 pi)) hw))
  (setq pp2 (polar pp1 (angle p1 p2) (distance p1 p2)))
  (setq pp3 (polar p2 (+ (angle p1 p2) (* 0.5 pi)) hw))
  (setq pp4 (polar pp3 (angle p2 p1) (distance p2 p1)))
  ;| ;;; entmake won't work just on this specific DWG - unknown reasons ;;;
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 0.0)
      (cons 10 pp1)
      (cons 42 0.0)
      (cons 10 pp2)
      (cons 42 1.0)
      (cons 10 pp3)
      (cons 42 0.0)
      (cons 10 pp4)
      (cons 42 1.0)
      (list 210 0.0 0.0 1.0)
    )
  )
  |;
  (vl-cmdf "_.pline" "_non" pp1 "_non" pp2 "_arc" "_s" "_non" (polar p2 (angle p1 p2) hw) "_non" pp3 "_line" "_non" pp4 "_arc" "_s" "_non" (polar p1 (angle p2 p1) hw) "_non" pp1 "_close")

  (setq enx (entget (entlast)))
  (setq enx (subst (cons 90 4) (assoc 90 enx) enx))
  (setq enx (append (reverse (vl-member-if '(lambda ( x ) (equal x (cons 42 1.0) 1e-6)) (reverse enx))) (list (vl-remove nil (if (assoc 91 enx) (cons 91 0))) (list 210 0.0 0.0 1.0))))
  (entupd (cdr (assoc -1 (entmod enx))))

  (*error* nil)
)

 

HTH.

Regards, M.R.

[Nikon]

marko_ribar
Thank you very much! Your work is very valuable!
It works great! All bindings are there, very convenient to use.

[marko_ribar]

This is way better than my approach...

 

https://www.theswamp.org/index.php?topic=58809.0

 

(defun c:slot ( / cmd dict ent lastent obj prev ss vals vars *error*)

  ;; ----------------------------------------------------------- ;;
  ;;                Draw Slot               29-11-2023 by dexus  ;;
  ;; ----------------------------------------------------------- ;;
  ;;  https://www.theswamp.org/index.php?topic=58809             ;;
  ;; ----------------------------------------------------------- ;;
  ;;  Draw a slot with preview                                   ;;
  ;;  Prompts user for radius, startpoint and endpoint           ;;
  ;;  Global variable 'slot:rad' for last radius                 ;;
  ;; ----------------------------------------------------------- ;;

  (defun *error* (msg)
    (and vals (mapcar (function setvar) vars vals))
    (or (wcmatch (strcase msg t) "*break,*cancel*,*exit*") (princ (strcat "\n* Error: " msg)))
    (princ)
  )

  (setq vars '("cmdecho" "peditaccept" "qaflags")
        vals (mapcar (function getvar) vars)
        dict (cdar (dictsearch (namedobjdict) "acad_mlinestyle")))
  (mapcar (function setvar) vars '(0 1 0))
  (initget 6)
  (if
    (cond
      ((not
        (setq slot:rad
          (cond
            ((getdist (if (numberp slot:rad) (strcat "\nSpecify slot radius <" (rtos slot:rad 2 3) ">: ") "\nSpecify slot radius: ")))
            (slot:rad)
          )
        ))
        (princ "\nNo slot radius chosen.") nil
      )
      ((not (setq ent ; Create MLineStyle
        (list
          '(0 . "MLINESTYLE") '(100 . "AcDbMlineStyle") '(2 . "SLOT") '(70 . 1088) '(3 . "") '(51 . 1.5708) '(52 . 1.5708) '(71 . 2)
          (cons 49 slot:rad) '(62 . 256) '(6 . "BYLAYER")
          (cons 49 (- slot:rad)) '(62 . 256) '(6 . "BYLAYER")
        )
      )))
      ((setq prev (dictsearch dict "slot")) ; If Slot exists, entmod
        (entmod (cons (assoc -1 prev) ent)) t
      )
      ((dictadd dict "SLOT" (entmakex ent)) ; Otherwise create Slot
        t
      )
      ((princ "\nCreation of mline failed...") nil)
    )
    (progn
      (setq lastent (entlast) cmd (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (princ "\nChoose first point: ")
      (command "_mline" "_j" "_z" "_st" "SLOT" "\\") ; Create Mline
      (princ "\nChoose end point: ")
      (command "\\" "") ; Get endpoint of Mline
      (if (not (equal lastent (setq obj (entlast))))
        (progn
          (setq lastent (entlast) ss (ssadd))
          (command "_explode" obj) ; Explode Mline
          (while (> (getvar "cmdactive") 0) (command ""))
          (while (setq lastent (entnext lastent)) (ssadd lastent ss))
          (command "_.pedit" "_m" ss "" "_j" "0.0" "") ; Convert to polyline
          (setq ss nil)
        )
      )
      (setvar 'cmdecho cmd)
    )
  )
  (mapcar (function setvar) vars vals)
  (princ)
)

 

Edited November 29, 2023 by marko_ribar

[Nikon]

Yes, the dynamics are from Stefan M. and the bindings are from marko_ribar.
Great job!

Command: SLOT
Specify slot radius <200>:
and in fact 4000???

20 times more!?

 

Edited November 30, 2023 by Nikon

[Nikon]

For those who work with metric units (cmlscale 20)
If you add a string to the code

(if (= (getvar 'cmlscale) 20) (setvar 'cmlscale 1) )

then cmlscale switches to 1 and the code works correctly.
Here is the code if the default is cmlscale 20.

(defun c:slot1 ( / cmd dict ent lastent obj prev ss vals vars *error*)

  ;; ----------------------------------------------------------- ;;
  ;;                Draw Slot               29-11-2023 by dexus  ;;
  ;; ----------------------------------------------------------- ;;
  ;;  https://www.theswamp.org/index.php?topic=58809             ;;
  ;; ----------------------------------------------------------- ;;
  ;;  Draw a slot with preview                                   ;;
  ;;  Prompts user for radius, startpoint and endpoint           ;;
  ;;  Global variable 'slot:rad' for last radius                 ;;
  ;; ----------------------------------------------------------- ;;
  ;; добавлена строка (if (= (getvar 'cmlscale) 20) (setvar 'cmlscale 1) ) ;;

  (defun *error* (msg)
    (and vals (mapcar (function setvar) vars vals))
    (or (wcmatch (strcase msg t) "*break,*cancel*,*exit*") (princ (strcat "\n* Error: " msg)))
    (princ)
  )
(if (= (getvar 'cmlscale) 20) (setvar 'cmlscale 1) )
  (setq vars '("cmdecho" "peditaccept" "qaflags" "cmlscale")
        vals (mapcar (function getvar) vars)
        dict (cdar (dictsearch (namedobjdict) "acad_mlinestyle")))
  (mapcar (function setvar) vars '(0 1 0))
  (initget 6)
  (if
    (cond
      ((not
        (setq slot:rad
          (cond
            ((getdist (if (numberp slot:rad) (strcat "\nSpecify slot radius <" (rtos slot:rad 2 3) ">: ") "\nSpecify slot radius: ")))
            (slot:rad)
          )
        ))
        (princ "\nNo slot radius chosen.") nil
      )
      ((not (setq ent ; Create MLineStyle
        (list
          '(0 . "MLINESTYLE") '(100 . "AcDbMlineStyle") '(2 . "SLOT") '(70 . 1088) '(3 . "") '(51 . 1.5708) '(52 . 1.5708) '(71 . 2)
          (cons 49 slot:rad) '(62 . 256) '(6 . "BYLAYER")
          (cons 49 (- slot:rad)) '(62 . 256) '(6 . "BYLAYER")
        )
      )))
      ((setq prev (dictsearch dict "slot")) ; If Slot exists, entmod
        (entmod (cons (assoc -1 prev) ent)) t
      )
      ((dictadd dict "SLOT" (entmakex ent)) ; Otherwise create Slot
        t
      )
      ((princ "\nCreation of mline failed...") nil)
    )
    (progn
      (setq lastent (entlast) cmd (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (princ "\nChoose first point: ")
      (command "_mline" "_j" "_z" "_st" "SLOT" "\\") ; Create Mline
      (princ "\nChoose end point: ")
      (command "\\" "") ; Get endpoint of Mline
      (if (not (equal lastent (setq obj (entlast))))
        (progn
          (setq lastent (entlast) ss (ssadd))
          (command "_explode" obj) ; Explode Mline
          (while (> (getvar "cmdactive") 0) (command ""))
          (while (setq lastent (entnext lastent)) (ssadd lastent ss))
          (command "_.pedit" "_m" ss "" "_j" "0.0" "") ; Convert to polyline
          (setq ss nil)
        )
      )
      (setvar 'cmdecho cmd)
    )
  )
  (mapcar (function setvar) vars vals)
  (princ)
)

How to make cmlscale return the value 20, after completing the command?

Edited December 6, 2023 by Nikon