Author Topic: Examples of usage GRREAD - let's share  (Read 199067 times)

0 Members and 3 Guests are viewing this topic.

LibertyOne

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #180 on: July 17, 2012, 10:57:47 AM »
A short, quick example to add to the collection:





Hi Lee! I see you are even taking up hockey in your spare time!

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #181 on: July 17, 2012, 11:00:52 AM »
Hi Lee! I see you are even taking up hockey in your spare time!

 :-D

nobody

  • Swamp Rat
  • Posts: 861
  • .net stuff
Re: Examples of usage GRREAD - let's share
« Reply #182 on: February 15, 2013, 03:00:15 AM »
Think I might redefine someone's PL with this :lmao:
Code - Auto/Visual Lisp: [Select]

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Examples of usage GRREAD - let's share
« Reply #183 on: May 28, 2014, 04:26:48 PM »
The first one is simple CIRCLE...

Code: [Select]
(defun c:cirt ( / cirl p n gr gp an d )

  (defun cirl ( n c / k a p1 p2 li lst )
    (setq k -1)
    (setq a (/ (* 2. pi) n))
    (repeat n
      (setq p1 (polar '(0. 0. 0.) (* a (setq k (1+ k))) 1.0))
      (setq p2 (polar '(0. 0. 0.) (* a (1+ k)) 1.0))
      (setq li (cons c (list p1 p2)))
      (setq lst (cons li lst))
    )
    (apply 'append (reverse lst))
  )
 
  (setq p (getpoint "\nPick or specify center point : "))
  (prompt "\nSpecify precision (< / >) : ")
  (setq n 6)
  (while (not (eq (car (setq gr (grread t 15 0))) 3))
    (redraw)
    (if (listp (cadr gr))
      (progn
        (setq gp (cadr gr))
        (setq an (angle p gp))
        (setq d (distance p gp))
        (grvecs (cirl n 1)
          (list
            (list (* d (cos an)) (* d (- (sin an))) 0. (car p))
            (list (* d (sin an)) (* d (cos an)) 0. (cadr p))
            (list 0. 0. d (caddr p))
            '(0. 0. 0. 1.)
          )
        )
      )
    )
    (if (eq (cadr gr) 60) (setq n (1- n)))
    (if (eq (cadr gr) 62) (setq n (1+ n)))
    (if (zerop n) (setq n 1))
  )
  (entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 d)))
  (redraw)
  (princ)
)

And the second one is G-HELIX - golden spiral - only one turn... :-(

Code: [Select]
(defun c:g-helix ( / *error* _acapp _getosmode _grX _OLE->ACI _OLE->RGB _RGB->ACI _snap _polarangs _polar _ortho ape as osm qcirl1 qcirl2 qcirl3 qcirl4 l1 l2 l3 l4 p1 p2 p3 p4 p5 o p s g pp n gr gp gps gpp an d )

  (vl-load-com)

  (defun *error* ( msg )
    (if ape (setvar 'aperture ape))
    (if as (setvar 'autosnap as))
    (if osm (setvar 'osmode osm))
    (if msg (prompt msg))
    (princ)
  )

  (defun _acapp nil
      (eval (list 'defun '_acapp 'nil (vlax-get-acad-object)))
      (_acapp)
  )

  (defun _getosmode ( os / lst )
      (foreach mode
         '(
              (0001 . "_end")
              (0002 . "_mid")
              (0004 . "_cen")
              (0008 . "_nod")
              (0016 . "_qua")
              (0032 . "_int")
              (0064 . "_ins")
              (0128 . "_per")
              (0256 . "_tan")
              (0512 . "_nea")
              (1024 . "_qui")
              (2048 . "_app")
              (4096 . "_ext")
              (8192 . "_par")
          )
          (if (not (zerop (logand (car mode) os)))
              (setq lst (cons "," (cons (cdr mode) lst)))
          )
      )
      (apply 'strcat (cdr lst))
  )

  (defun _grX ( p s c / -s r j )
      (setq -s (- s)
             r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
             j p
      )
      (grdraw (mapcar '+ j (list (* r -s) (* r -s))) (mapcar '+ j (list (* r s) (* r s))) c)
      (grdraw (mapcar '+ j (list (* r -s) (* r (1+ -s)))) (mapcar '+ j (list (* r (1- s)) (* r s))) c)
      (grdraw (mapcar '+ j (list (* r (1+ -s)) (* r -s))) (mapcar '+ j (list (* r s) (* r (1- s)))) c)
     
      (grdraw (mapcar '+ j (list (* r -s) (* r s))) (mapcar '+ j (list (* r s) (* r -s))) c)
      (grdraw (mapcar '+ j (list (* r -s) (* r (1- s)))) (mapcar '+ j (list (* r (1- s)) (* r -s))) c)
      (grdraw (mapcar '+ j (list (* r (1+ -s)) (* r s))) (mapcar '+ j (list (* r s) (* r (1+ -s)))) c)

      p
  )

  (defun _OLE->ACI ( c )
      (apply '_RGB->ACI (_OLE->RGB c))
  )

  (defun _OLE->RGB ( c )
      (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
  )

  (defun _RGB->ACI ( r g b / c o )
      (if (setq o (vla-getinterfaceobject (_acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
          (progn
              (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
              (vlax-release-object o)
              (if (vl-catch-all-error-p c)
                  (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                  c
              )
          )
      )
  )

  (defun _snap ( p osm )
    (if (osnap p (_getosmode osm))
      (osnap p (_getosmode osm))
      p
    )
  )

  (defun _polarangs ( ang / n k a l )
    (if (/= ang 0.0)
      (progn
        (setq n (/ 360.1 (cvunit ang "radians" "degrees")))
        (setq k -1.0)
        (repeat (1+ (fix n))
          (setq a (* (setq k (1+ k)) ang))
          (setq l (cons a l))
        )
        l
      )
      (list 0.0)
    )
  )

  (defun _polar ( p0 p flag ang / a b an )
    (if flag
      (progn
        (setq a (car (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
        (setq b (last (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
        (if (< (abs (- (angle p0 p) a)) (abs (- (angle p0 p) b))) (setq an a) (setq an b))
        (inters p0 (polar p0 an 1.0) p (polar p (+ an (* 0.5 pi)) 1.0) nil)
      )
      p
    )
  )

  (defun _ortho ( p0 p flag )
    (if flag
      (_polar p0 p t (* 0.5 pi))
      p
    )
  )

  (defun qcirl1 ( n c / k a p1 p2 li lst )
    (setq k -1)
    (setq a (/ (* 0.5 pi) n))
    (repeat n
      (setq p1 (polar '(0. 0. 0.) (* a (setq k (1+ k))) 1.))
      (setq p2 (polar '(0. 0. 0.) (* a (1+ k)) 1.))
      (setq li (cons c (list p1 p2)))
      (setq lst (cons li lst))
    )
    (apply 'append (reverse lst))
  )
 
  (defun qcirl2 ( n c / k a p1 p2 li lst )
    (setq k -1)
    (setq a (/ (* 0.5 pi) n))
    (repeat n
      (setq p1 (polar (list 0. (- 1. g) 0.) (+ (* 0.5 pi) (* a (setq k (1+ k)))) g))
      (setq p2 (polar (list 0. (- 1. g) 0.) (+ (* 0.5 pi) (* a (1+ k))) g))
      (setq li (cons c (list p1 p2)))
      (setq lst (cons li lst))
    )
    (apply 'append (reverse lst))
  )

  (defun qcirl3 ( n c / k a p1 p2 li lst )
    (setq k -1)
    (setq a (/ (* 0.5 pi) n))
    (repeat n
      (setq p1 (polar (list (- (- g (* g g))) (- 1. g) 0.) (+ (* 1.0 pi) (* a (setq k (1+ k)))) (* g g)))
      (setq p2 (polar (list (- (- g (* g g))) (- 1. g) 0.) (+ (* 1.0 pi) (* a (1+ k))) (* g g)))
      (setq li (cons c (list p1 p2)))
      (setq lst (cons li lst))
    )
    (apply 'append (reverse lst))
  )

  (defun qcirl4 ( n c / k a p1 p2 li lst )
    (setq k -1)
    (setq a (/ (* 0.5 pi) n))
    (repeat n
      (setq p1 (polar (list (- (- g (* g g))) (* g g g) 0.) (+ (* 1.5 pi) (* a (setq k (1+ k)))) (* g g g)))
      (setq p2 (polar (list (- (- g (* g g))) (* g g g) 0.) (+ (* 1.5 pi) (* a (1+ k))) (* g g g)))
      (setq li (cons c (list p1 p2)))
      (setq lst (cons li lst))
    )
    (apply 'append (reverse lst))
  )

  (setq g (/ (- (sqrt 5.) 1.) 2.))
  (setq pp (getpoint "\nPick or specify center point : "))
  (setvar 'orthomode 1)
  (setq ape (getvar 'aperture))
  (setvar 'aperture 40)
  (setq as (getvar 'autosnap))
  (setvar 'autosnap 31)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 15359)
  (if (eq (getvar 'orthomode) 1) (setq o t) (setq o nil))
  (if (eq (logand (getvar 'autosnap) 8) 8) (setq p t) (setq p nil))
  (if (eq (logand (getvar 'autosnap) 16) 16) (setq s t) (setq s nil))
  (prompt "\nSpecify precision (< / >) : ")
  (setq n 6)
  (while (not (eq (car (setq gr (grread t 15 0))) 3))
    (redraw)
    (if (listp (cadr gr))
      (progn
        (setq gp (cadr gr))
        (setq gpp (cadr gr))
        (if gps (setq an (angle pp gps)) (setq an (angle pp gp)))
        (if gps (setq d (distance pp gps)) (setq d (distance pp gp)))
        (setq l1 (qcirl1 n 1))
        (setq l2 (qcirl2 n 1))
        (setq l3 (qcirl3 n 1))
        (setq l4 (qcirl4 n 1))
        (grvecs (append l1 l2 l3 l4)
          (list
            (list (* d (cos an)) (* d (- (sin an))) 0. (car pp))
            (list (* d (sin an)) (* d (cos an)) 0. (cadr pp))
            (list 0. 0. d (caddr pp))
            '(0. 0. 0. 1.)
          )
        )
      )
    )
    (cond
      ( (eq (cadr gr) 15)
        (if (eq o t) (setq o nil) (setq o t))
      )
      ( (eq (cadr gr) 21)
        (if (eq p t) (setq p nil) (setq p t))
      )
      ( (eq (cadr gr) 6)
        (if (eq s t) (setq s nil) (setq s t))
      )
    )
    (cond
      ( (and o p s)
        (setq gps (_snap (_ortho pp gp t) (getvar 'osmode)))
      )
      ( (and o (not p) s)
        (setq gps (_snap (_ortho pp gp t) (getvar 'osmode)))
      )
      ( (and (not o) p s)
        (setq gps (_snap (_polar pp gp t (getvar 'polarang)) (getvar 'osmode)))
      )
      ( (and (not o) (not p) s)
        (setq gps (_snap gp (getvar 'osmode)))
      )
      ( (and o p (not s))
        (setq gps (_ortho pp gp t))
      )
      ( (and o (not p) (not s))
        (setq gps (_ortho pp gp t))
      )
      ( (and (not o) p (not s))
        (setq gps (_polar pp gp t (getvar 'polarang)))
      )
      ( (and (not o) (not p) (not s))
        (setq gps gp)
      )
    )
    (if (not (equal gps gpp 1e-6))
      (_grX gps (atoi (getenv "AutoSnapSize")) (_OLE->ACI (if (= 1 (getvar 'cvport)) (atoi (getenv "Layout AutoSnap Color")) (atoi (getenv "Model AutoSnap Color")))))
    )
    (if (eq (cadr gr) 60) (setq n (1- n)))
    (if (eq (cadr gr) 62) (setq n (1+ n)))
    (if (zerop n) (setq n 1))
  )
  (setq an (angle pp gps))
  (setq d (distance pp gps))
  (setq p1 (polar pp an d))
  (setq p2 (polar pp (+ (* 0.5 pi) an) d))
  (setq p3 (polar (polar pp (+ (* 0.5 pi) an) (* d g g)) (+ pi an) (* d g)))
  (setq p4 (polar (polar (polar pp (+ (* 0.5 pi) an) (* d g g)) (+ pi an) (* d g g g)) (+ (* 1.5 pi) an) (* d g g)))
  (setq p5 (polar (polar (polar (polar pp (+ (* 0.5 pi) an) (* d g g)) (+ pi an) (* d g g g)) (+ (* 1.5 pi) an) (* d g g g g)) an (* d g g g)))
  (entmake (list
                  '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(90 . 5)
                  (cons 70 (if (eq (getvar 'plinegen) 1) 128 0))
                  '(38 . 0.0)
                  (cons 10 p1)
                  (cons 42 (- (sqrt 2.) 1.))
                  (cons 10 p2)
                  (cons 42 (- (sqrt 2.) 1.))
                  (cons 10 p3)
                  (cons 42 (- (sqrt 2.) 1.))
                  (cons 10 p4)
                  (cons 42 (- (sqrt 2.) 1.))
                  (cons 10 p5)
                  (cons 42 0.0)
                  '(210 0.0 0.0 1.0)
           )
  )
  (redraw)
  (while (eq (getstring "\nAnother turn - ENTER; Any other key+ENTER to finish") "")
    (setq pp (polar p5 (+ pi an) (* d g g g g)))
    (setq d (* d g g g g))
    (setq p1 (polar pp an d))
    (setq p2 (polar pp (+ (* 0.5 pi) an) d))
    (setq p3 (polar (polar pp (+ (* 0.5 pi) an) (* d g g)) (+ pi an) (* d g)))
    (setq p4 (polar (polar (polar pp (+ (* 0.5 pi) an) (* d g g)) (+ pi an) (* d g g g)) (+ (* 1.5 pi) an) (* d g g)))
    (setq p5 (polar (polar (polar (polar pp (+ (* 0.5 pi) an) (* d g g)) (+ pi an) (* d g g g)) (+ (* 1.5 pi) an) (* d g g g g)) an (* d g g g)))
    (entmake (list
                    '(0 . "LWPOLYLINE")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbPolyline")
                    '(90 . 5)
                    (cons 70 (if (eq (getvar 'plinegen) 1) 128 0))
                    '(38 . 0.0)
                    (cons 10 p1)
                    (cons 42 (- (sqrt 2.) 1.))
                    (cons 10 p2)
                    (cons 42 (- (sqrt 2.) 1.))
                    (cons 10 p3)
                    (cons 42 (- (sqrt 2.) 1.))
                    (cons 10 p4)
                    (cons 42 (- (sqrt 2.) 1.))
                    (cons 10 p5)
                    (cons 42 0.0)
                    '(210 0.0 0.0 1.0)
             )
    )
  )
  (*error* nil)
)

Regards, M.R.
« Last Edit: May 31, 2014, 04:51:08 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

reltro

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #184 on: May 29, 2014, 08:38:58 AM »
 :-)
nice thread...
here a function I wrote...

its some kind of interface to speed up the work with the mouse... normally I type the commands, but then I worked with a pen on a tablet; it was annoying to go all the way to the buttons, so I wrote this (code in the attachment).

Its pretty easy to put in more commands... It identifys also right/left click and also one-char-shortcuts... It don't reconize enter or space yet to repeat the last command, but I wanna add this soon...

Have a look...
command = Interface

reltro

kruuger

  • Swamp Rat
  • Posts: 625
Re: Examples of usage GRREAD - let's share
« Reply #185 on: May 29, 2014, 08:51:31 AM »
:)
nice thread...
here a function I wrote...

its some kind of interface to speed up the work with the mouse... normally I type the commands, but then I worked with a pen on a tablet; it was annoying to go all the way to the buttons, so I wrote this (code in the attachment).

Its pretty easy to put in more commands... It identifys also right/left click and also one-char-shortcuts... It don't reconize enter or space yet to repeat the last command, but I wanna add this soon...

Have a look...
command = Interface

reltro
how to use it ? sample please ?

reltro

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #186 on: May 29, 2014, 08:52:48 AM »
Hey kruuger...

load it and then type Interface... ;)

kruuger

  • Swamp Rat
  • Posts: 625
Re: Examples of usage GRREAD - let's share
« Reply #187 on: May 29, 2014, 08:57:27 AM »
Hey kruuger...

load it and then type Interface... ;)
ahh those crazy evel
thanks


EDIT:o sh... sick... :)

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Examples of usage GRREAD - let's share
« Reply #188 on: May 29, 2014, 09:04:13 AM »
:)
nice thread...
here a function I wrote...

its some kind of interface to speed up the work with the mouse... normally I type the commands, but then I worked with a pen on a tablet; it was annoying to go all the way to the buttons, so I wrote this (code in the attachment).

Its pretty easy to put in more commands... It identifys also right/left click and also one-char-shortcuts... It don't reconize enter or space yet to repeat the last command, but I wanna add this soon...

Have a look...
command = Interface

reltro


That's pretty cool  :kewl:

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

reltro

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #189 on: May 29, 2014, 09:12:37 AM »
EDIT:o sh... sick... :)

That's pretty cool  :kewl:

:) thanks a lot...
Will add a guide to modify it... and the repeat-last-command... but at the moment there isn't much time...
Any other suggestions?

reltro

kruuger

  • Swamp Rat
  • Posts: 625
Re: Examples of usage GRREAD - let's share
« Reply #190 on: May 29, 2014, 10:10:39 AM »
EDIT:o sh... sick... :)

That's pretty cool  :kewl:

:) thanks a lot...
Will add a guide to modify it... and the repeat-last-command... but at the moment there isn't much time...
Any other suggestions?

reltro
what method do you use to draw this "interfaca"?

reltro

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #191 on: May 29, 2014, 10:27:58 AM »
what method do you use to draw this "interfaca"?

It uses (grvecs ... ...) to draw and (redraw) to clean the display...

reltro

kruuger

  • Swamp Rat
  • Posts: 625
Re: Examples of usage GRREAD - let's share
« Reply #192 on: May 29, 2014, 12:35:34 PM »
what method do you use to draw this "interfaca"?
It uses (grvecs ... ...) to draw and (redraw) to clean the display...

reltro

i mean how do you calculate all those points.? how do you prepare your "graphics"?
k.

reltro

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #193 on: May 29, 2014, 12:54:56 PM »
i mean how do you calculate all those points.? how do you prepare your "graphics"?
k.

Ah ok ;)
I think the parts of the circles aren't the problem? simple math...

The graphics are hardcoded...

The "graphics" I draw in acad using colored lines and then I use the code below to prepare them for (grvecs.
The "line-graphic" should be drawn near the WCS-origin, (0,0,0) will be the "InsertPoint"

In the main-code they are transformed (rotated, scaled) to fit in the circle-part-boundary (simple vector-math) ;)

Code: [Select]
;;reading the start-/end-point and also the color of any selected line-object...

(defun C:CreateSymbol (/ s Out ent)
    (princ "\nselect Lines")
    (if (setq s (ssget '((0 . "LINE"))))
        (foreach e (ssnamex s)
            (if (= 'ename (type (cadr e)))
                (setq    ent (entget (cadr e))
                        Out    (cons
                                (cons
                                    (    (lambda (c / )
                                            (if c
                                                c
                                                7
                                            )
                                        )
                                        (cdr (assoc 62 ent))
                                    )
                                    (mapcar
                                        '(lambda (g / p)
                                            (setq p (cdr (assoc g ent)))
                                            (mapcar
                                                '(lambda (a / )
                                                    (fix (* a 1000))
                                                )
                                                (list (car p) (cadr p))
                                               
                                            )
                                        )
                                        '(10 11)
                                    )
                                )
                                Out
                            )
                )
            )
        )
    )
    (apply 'append Out)
)

for the text look at this thread http://www.theswamp.org/index.php?topic=46966.0

reltro
« Last Edit: May 29, 2014, 12:59:42 PM by reltro »

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Examples of usage GRREAD - let's share
« Reply #194 on: May 29, 2014, 01:06:21 PM »
That is sick.....I love it!
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016