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

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #165 on: July 14, 2011, 08:27:48 PM »
Some fun with GrRead following a thread at CT:

Dynamic Horizontal Lines:



Code: [Select]
(defun c:hlines ( / *error* g1 g2 gr h l ms p p1 p2 v )
  ;; Lee Mac 2011
  (defun *error* ( m ) (redraw) (princ))
  (or *n (setq *n 3))
 
  (if (setq p1 (getpoint "\nSpecify First Corner: "))
    (progn
      (setq ms (princ "\nSpecify Opposite Corner [+/-]: "))
      (while
        (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
          (cond
            ( (= 5 g1)(redraw)
              (setq h (- (car g2) (car p1))
                    v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                    p p1
              )
              (repeat *n
                (setq p (list (car p) (+ v (cadr p)) (caddr p)))
                (grdraw p (list (+ (car p) h) (cadr p) (caddr p)) -1)
              )
              (setq l
                (list
                  p1 (list (+ (car p1) h) (cadr p1) (caddr p1))
                  g2 (list (car p) (+ v (cadr p)) (caddr p))
                )
              )
              (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))))
            )
            ( (= 2 g1)
              (cond
                ( (member g2 '(45 95))
                  (if (= 1 *n)
                    (princ (strcat "\n--> Minimum Number of Lines Reached." ms))
                    (setq *n (1- *n))
                  )
                )
                ( (member g2 '(43 61))
                  (setq *n (1+ *n))
                )
              )
            )
            ( (= 3 g1)
              (setq h (- (car g2) (car p1))
                    v (/ (- (cadr g2) (cadr p1)) (1+ *n))
              )
              (repeat *n (setq p1 (list (car p1) (+ v (cadr p1)) (caddr p1)))
                (entmakex
                  (list
                    (cons 0 "LINE")
                    (cons 10 (trans p1 1 0))
                    (cons 11 (trans (list (+ (car p1) h) (cadr p1) (caddr p1)) 1 0))
                  )
                )
              )
              nil
            )
          )
        )
      )
    )
  )
  (redraw) (princ)
)

Dynamic Vertical Lines:



Code: [Select]
(defun c:vlines ( / *error* g1 g2 gr h l ms p p1 p2 v )
  ;; Lee Mac 2011
  (defun *error* ( m ) (redraw) (princ))
  (or *n (setq *n 3))
 
  (if (setq p1 (getpoint "\nSpecify First Corner: "))
    (progn
      (setq ms (princ "\nSpecify Opposite Corner [+/-]: "))
      (while
        (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
          (cond
            ( (= 5 g1)(redraw)
              (setq h (/ (- (car g2) (car p1)) (1+ *n))
                    v (- (cadr g2) (cadr p1))
                    p p1
              )
              (repeat *n
                (setq p (list (+ h (car p)) (cadr p) (caddr p)))
                (grdraw p (list (car p) (+ v (cadr p)) (caddr p)) -1)
              )
              (setq l
                (list
                  p1 (list (car p1) (+ v (cadr p1)) (caddr p1))
                  g2 (list (+ h (car p)) (cadr p) (caddr p))
                )
              )
              (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))))
            )
            ( (= 2 g1)
              (cond
                ( (member g2 '(45 95))
                  (if (= 1 *n)
                    (princ (strcat "\n--> Minimum Number of Lines Reached." ms))
                    (setq *n (1- *n))
                  )
                )
                ( (member g2 '(43 61))
                  (setq *n (1+ *n))
                )
              )
            )
            ( (= 3 g1)
              (setq h (/ (- (car g2) (car p1)) (1+ *n))
                    v (- (cadr g2) (cadr p1))
              )
              (repeat *n (setq p1 (list (+ h (car p1)) (cadr p1) (caddr p1)))
                (entmakex
                  (list
                    (cons 0 "LINE")
                    (cons 10 (trans p1 1 0))
                    (cons 11 (trans (list (car p1) (+ v (cadr p1)) (caddr p1)) 1 0))
                  )
                )
              )
              nil
            )
          )
        )
      )
    )
  )
  (redraw) (princ)
)

Combining the two...



Code: [Select]
(defun c:hvlines ( / *error* g1 g2 gr h l ms p p1 p2 v )
  ;; Lee Mac 2011
  (defun *error* ( m ) (redraw) (princ))
  (or *n (setq *n 3))
 
  (if (setq p1 (getpoint "\nSpecify First Corner: "))
    (progn
      (setq ms (princ "\nSpecify Opposite Corner [TAB/+/-]: "))
      (while
        (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
          (cond
            ( (= 5 g1)(redraw)
              (if *v
                (progn
                  (setq h (/ (- (car g2) (car p1)) (1+ *n))
                        v (- (cadr g2) (cadr p1))
                        p p1
                  )
                  (repeat *n
                    (setq p (list (+ h (car p)) (cadr p) (caddr p)))
                    (grdraw p (list (car p) (+ v (cadr p)) (caddr p)) -1)
                  )
                  (setq l
                    (list
                      p1 (list (car p1) (+ v (cadr p1)) (caddr p1))
                      g2 (list (+ h (car p)) (cadr p) (caddr p))
                    )
                  )
                )
                (progn
                  (setq h (- (car g2) (car p1))
                        v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                        p p1
                  )
                  (repeat *n
                    (setq p (list (car p) (+ v (cadr p)) (caddr p)))
                    (grdraw p (list (+ (car p) h) (cadr p) (caddr p)) -1)
                  )
                  (setq l
                    (list
                      p1 (list (+ (car p1) h) (cadr p1) (caddr p1))
                      g2 (list (car p) (+ v (cadr p)) (caddr p))
                    )
                  )
                )
              )                 
              (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))))
            )
            ( (= 2 g1)
              (cond
                ( (member g2 '(45 95))
                  (if (= 1 *n)
                    (princ (strcat "\n--> Minimum Number of Lines Reached." ms))
                    (setq *n (1- *n))
                  )
                )
                ( (member g2 '(43 61))
                  (setq *n (1+ *n))
                )
                ( (= 9 g2)
                  (setq *v (not *v)) t
                )
              )
            )
            ( (= 3 g1)
              (if *v
                (progn
                  (setq h (/ (- (car g2) (car p1)) (1+ *n))
                        v (- (cadr g2) (cadr p1))
                  )
                  (repeat *n (setq p1 (list (+ h (car p1)) (cadr p1) (caddr p1)))
                    (entmakex
                      (list
                        (cons 0 "LINE")
                        (cons 10 (trans p1 1 0))
                        (cons 11 (trans (list (car p1) (+ v (cadr p1)) (caddr p1)) 1 0))
                      )
                    )
                  )
                )
                (progn
                  (setq h (- (car g2) (car p1))
                        v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                  )
                  (repeat *n (setq p1 (list (car p1) (+ v (cadr p1)) (caddr p1)))
                    (entmakex
                      (list
                        (cons 0 "LINE")
                        (cons 10 (trans p1 1 0))
                        (cons 11 (trans (list (+ (car p1) h) (cadr p1) (caddr p1)) 1 0))
                      )
                    )
                  )
                )
              )
              nil
            )
          )
        )
      )
    )
  )
  (redraw) (princ)
)

 :-)

myloveflyer

  • Newt
  • Posts: 145
Re: Examples of usage GRREAD - let's share
« Reply #166 on: July 14, 2011, 11:55:23 PM »
Cool,LEE :-D
Never give up !

kruuger

  • Swamp Rat
  • Posts: 616
Re: Examples of usage GRREAD - let's share
« Reply #167 on: July 15, 2011, 03:33:56 AM »
good example Lee.
more lines to reveiw :)
kruuger

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #168 on: July 15, 2011, 07:06:33 AM »
Thanks guys  :-)

Ketxu

  • Newt
  • Posts: 104
Re: Examples of usage GRREAD - let's share
« Reply #169 on: September 14, 2011, 12:57:58 PM »
Wrote a more practical one and thought I'd do a crappy GRREAD example:

Code: [Select]
(defun c:Test (/ _grAngle _ss2lst lst gr pt)

  (vl-load-com)

  (defun _grAngle (a b) (grdraw (trans a 0 1) (cadr gr) 1 -1) (angle a b))

  (defun _ss2lst (ss / i l)
    (if (eq (type ss) 'PICKSET)
      (repeat (setq i (sslength ss))
        (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
      )
    )
  )

  (if (setq lst (_ss2lst (ssget "_:L" '((0 . "INSERT")))))
    (while (eq 5 (car (setq gr (grread T 15 0))))
      (setq pt (trans (cadr gr) 1 0))
      (redraw)
      (foreach o lst (vla-put-rotation o (_grAngle (vlax-get o 'InsertionPoint) pt)))
    )
  )
  (redraw)
  (princ)
)


I like thi motion, so i change a little to do with almost object type. With vla-rotate, Lines like ceiling fans ^^

Code: [Select]
(defun _grAngle (a b) (grdraw (trans a 0 1) (cadr gr) 1 -1) (angle a b))
(defun _Bound-Center (ent opt / p1 p2 _ent eType mid)
;Get center boundingbox of object. If opt, choice InsertionPoint instead of
(setq  eType (cdadr (entget (vlax-vla-object->ename ent))))
(setq mid (cond ((and opt  (wcmatch eType "INSERT,TEXT,MTEXT"))
(vlax-get ent 'InsertionPoint))
(T
(vla-getboundingbox ent 'p1 'p2)
(mapcar  '(lambda (a b) (* 0.5 (+ a b)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
)
))
(defun c:Test1 (/ lst gr pt SelSet)
(vl-load-com)
  (if (and (setq lst (ssget "_:L"))
(setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))
    (while (eq 5 (car (setq gr (grread T 15 0))))
      (setq pt (trans (cadr gr) 1 0))
      (redraw)
      (vlax-for object Selset (vla-rotate object (vlax-3d-point (_Bound-Center object nil)) (_grAngle (_Bound-Center object nil) pt)))
    )
  )
  (redraw)
  (princ)
)
 
(defun c:Test2 (/ lst gr pt SelSet)
(vl-load-com)
  (if (and (setq lst (ssget "_:L"))
(setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))
    (while (eq 5 (car (setq gr (grread T 15 0))))
      (setq pt (trans (cadr gr) 1 0))
      (redraw)
      (vlax-for object Selset (vla-rotate object (vlax-3d-point (_Bound-Center object T)) (_grAngle (_Bound-Center object T) pt)))
    )
  )
  (redraw)
  (princ)
)

Hugo

  • Bull Frog
  • Posts: 309
Re: Examples of usage GRREAD - let's share
« Reply #170 on: December 20, 2011, 02:49:27 PM »
Please Help

When I broke off the Lisp if I want to rotate the text.
Thank you

Bitte um Hilfe

Bei mir bricht das Lisp ab wenn ich den Text drehen will.
Danke

Quote
(defun c:THZ ( / e i j ) (vl-load-com) (setq i (/ pi 2.) j -1.);;-1.
      (setq e (entsel "\nText wählen: "))
             (setq el1 (entget (car e)))
             (setq p0 (cdr (assoc 10 el1)))
             (setq muster (cdr (assoc 1 el1)))
    (while (setq p1 (getpoint p0  "\nText anschreiben: "))
      (progn
   (setq p0 p1)
         (setq txt (umw_muster (cdr (assoc 1 el1))))
          (setq el1 (subst (cons 1 txt) (assoc 1 el1) el1))
          (setq el1 (subst (cons 10 p1) (assoc 10 el1) el1))
          (entmake el1)
   )
      ;; © Lee Mac 2011
      (if
   (and
          (setq e (entlast))
          (eq (vla-get-Objectname (setq e (vlax-ename->vla-object e))) "AcDbText")
          (princ "\nPress [Tab] to Change Projection <Accept>")
        )
        (while (= 9 (cadr (grread nil 12 0)))
           (vla-put-rotation     e i)
           (vla-put-obliqueangle e (setq i (* i (setq j (- j)))))
        )
      )
      )
  )



alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #171 on: December 20, 2011, 05:13:58 PM »


Code - Auto/Visual Lisp: [Select]
  1. (defun c:test (/ AT:isAnnotative _grdist ent data bp obj scl gr)
  2.   ;; dynamically scale arrowhead size of selected MLeader
  3.   ;; Alan J. Thompson, 12.17.11
  4.  
  5.  
  6.   (defun AT:isAnnotative (ename / check)
  7.     ;; Check if entity is annotative
  8.     ;; ename - ename to check (returns T if annotative)
  9.     ;; Alan J. Thompson
  10.     (and (setq check (cdr (assoc 360 (entget ename))))
  11.          (setq check (dictsearch check "AcDbContextDataManager"))
  12.          (setq check (dictsearch (cdr (assoc -1 check)) "AcDb_AnnotationScales"))
  13.          (assoc 350 check)
  14.     )
  15.   )
  16.  
  17.   (defun _grdist (b p s) (redraw) (grdraw b p 256 -1) (* (distance b p) s))
  18.  
  19.   (cond
  20.     ((not (setq ent (car (entsel "\nSelect multileader to change arrowhead size: ")))))
  21.     ((not (eq (cdr (assoc 0 (setq data (entget ent)))) "MULTILEADER"))
  22.      (princ "\nInvalid object!")
  23.     )
  24.     (T
  25.      (setq bp  (trans (cdr (assoc 10 (cdr (member (assoc 10 (cdr (member (assoc 10 data) data))) data))))
  26.                       ent
  27.                       1
  28.                )
  29.            obj (vlax-ename->vla-object ent)
  30.            scl (if (AT:isAnnotative ent)
  31.                  (getvar 'CANNOSCALEVALUE)
  32.                  (cdr (assoc 40 data))
  33.                )
  34.      )
  35.  
  36.      (while (eq (car (setq gr (grread T 15 0))) 5)
  37.        (vl-catch-all-apply 'vla-put-arrowheadsize (list obj (_grdist bp (cadr gr) scl)))
  38.      )
  39.     )
  40.   )
  41.  
  42.   (redraw)
  43.   (princ)
  44. )
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

FreeBird

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #172 on: December 22, 2011, 09:48:24 AM »
Interface function for grread
Code - Auto/Visual Lisp: [Select]
  1. (setq loop T)
  2. (while loop
  3.   (setq code (grread T 8))
  4.   (cond
  5.     ((= (car code) 5)     (do_Move))               ;;; mouse move
  6.     ((= (car code) 3)     (do_Left))               ;;; mouse left button
  7.     ((= (car code) 11)    (do_Right))              ;;; mouse right button, right button as return
  8.     ((= (car code) 25)    (do_Right))              ;;; mouse right button, right button as screen menu
  9.     ((equal code '(2 0))  (do_CTRL-@))             ;;; CTRL-@
  10.     ((equal code '(2 1))  (do_CTRL-A))             ;;; CTRL-A
  11.     ((equal code '(2 2))  (do_F9))                 ;;; CTRL-B or F9
  12.     ((equal code '(2 3))  (do_F12))                ;;; CTRL-C or F12
  13.     ((equal code '(2 4))  (do_F6))                 ;;; CTRL-D or F6
  14.     ((equal code '(2 5))  (do_F5))                 ;;; CTRL-E or F5
  15.     ((equal code '(2 6))  (do_F3))                 ;;; CTRL-F or F3
  16.     ((equal code '(2 7))  (do_F7))                 ;;; CTRL-G or F7
  17.     ((equal code '(2 8))  (do_Back))               ;;; CTRL-H or backspace
  18.     ((equal code '(2 9))  (do_Tab))                ;;; CTRL-I or Tab
  19.     ((equal code '(2 10)) (do_CTRL-J))             ;;; CTRL-J
  20.     ((equal code '(2 11)) (do_CTRL-K))             ;;; CTRL-K
  21.     ((equal code '(2 12)) (do_CTRL-L))             ;;; CTRL-L
  22.     ((equal code '(2 13)) (do_Return))             ;;; CTRL-M or return
  23.     ((equal code '(2 14)) (do_CTRL-N))             ;;; CTRL-N
  24.     ((equal code '(2 15)) (do_F8))                 ;;; CTRL-O or F8
  25.     ((equal code '(2 16)) (do_CTRL-P))             ;;; CTRL-P
  26.     ((equal code '(2 17)) (do_CTRL-Q))             ;;; CTRL-Q
  27.     ((equal code '(2 18)) (do_CTRL-R))             ;;; CTRL-R
  28.     ((equal code '(2 19)) (do_CTRL-S))             ;;; CTRL-S
  29.     ((equal code '(2 20)) (do_F4))                 ;;; CTRL-T or F4
  30.     ((equal code '(2 21)) (do_F10))                ;;; CTRL-U or F10
  31.     ((equal code '(2 22)) (do_CTRL-V))             ;;; CTRL-V
  32.     ((equal code '(2 23)) (do_F11))                ;;; CTRL-W or F11
  33.     ((equal code '(2 24)) (do_CTRL-X))             ;;; CTRL-X
  34.     ((equal code '(2 25)) (do_CTRL-Y))             ;;; CTRL-Y
  35.     ((equal code '(2 26)) (do_CTRL-Z))             ;;; CTRL-Z
  36.     ((equal code '(2 27)) (do_CTRL-[))             ;;; CTRL-[ or ESC
  37.     ((equal code '(2 28)) (do_CTRL-\))             ;;; CTRL-\
  38.     ((equal code '(2 29)) (do_CTRL-]))             ;;; CTRL-]
  39.     ((equal code '(2 30)) (do_CTRL-^))             ;;; CTRL-^
  40.     ((equal code '(2 31)) (do_CTRL-_))             ;;; CTRL-_
  41.     ((equal code '(2 32)) (do_Space))              ;;; space key
  42.     ((equal code '(2 33)) (do_ExclamationMark))    ;;; ! key
  43.     ((equal code '(2 34)) (do_DoubleQuote))        ;;; " key
  44.     ((equal code '(2 35)) (do_Hash))               ;;; # key
  45.     ((equal code '(2 36)) (do_Dollar))             ;;; $ key
  46.     ((equal code '(2 37)) (do_Percent))            ;;; % key
  47.     ((equal code '(2 38)) (do_Ampersand))          ;;; & key
  48.     ((equal code '(2 39)) (do_Apostrophe))         ;;; ' key
  49.     ((equal code '(2 40)) (do_OpenParenthesis))    ;;;  ( key
  50.     ((equal code '(2 41)) (do_CloseParenthesis))   ;;; ) key
  51.     ((equal code '(2 42)) (do_Asterisk))           ;;; * key
  52.     ((equal code '(2 43)) (do_Plus))               ;;; + key
  53.     ((equal code '(2 44)) (do_Comma))              ;;; , key
  54.     ((equal code '(2 45)) (do_Minus))              ;;; - key
  55.     ((equal code '(2 46)) (do_Dot))                ;;; . key
  56.     ((equal code '(2 47)) (do_Slash))              ;;; / key
  57.     ((equal code '(2 48)) (do_0))                  ;;; 0 key
  58.     ((equal code '(2 49)) (do_1))                  ;;; 1 key
  59.     ((equal code '(2 50)) (do_2))                  ;;; 2 key
  60.     ((equal code '(2 51)) (do_3))                  ;;; 3 key
  61.     ((equal code '(2 52)) (do_4))                  ;;; 4 key
  62.     ((equal code '(2 53)) (do_5))                  ;;; 5 key
  63.     ((equal code '(2 54)) (do_6))                  ;;; 6 key
  64.     ((equal code '(2 55)) (do_7))                  ;;; 7 key
  65.     ((equal code '(2 56)) (do_8))                  ;;; 8 key
  66.     ((equal code '(2 57)) (do_9))                  ;;; 9 key
  67.     ((equal code '(2 58)) (do_Colon))              ;;; : key
  68.     ((equal code '(2 59)) (do_Semicolon))          ;;; ; key
  69.     ((equal code '(2 60)) (do_LessThan))           ;;; < key
  70.     ((equal code '(2 61)) (do_Equals))             ;;; = key
  71.     ((equal code '(2 62)) (do_GreatThan))          ;;; > key
  72.     ((equal code '(2 63)) (do_QuestionMark))       ;;; ? key
  73.     ((equal code '(2 64)) (do_At))                 ;;; @ key
  74.     ((equal code '(2 65)) (do_A))                  ;;; A key
  75.     ((equal code '(2 66)) (do_B))                  ;;; B key
  76.     ((equal code '(2 67)) (do_C))                  ;;; C key
  77.     ((equal code '(2 68)) (do_D))                  ;;; D key
  78.     ((equal code '(2 69)) (do_E))                  ;;; E key
  79.     ((equal code '(2 70)) (do_F))                  ;;; F key
  80.     ((equal code '(2 71)) (do_G))                  ;;; G key
  81.     ((equal code '(2 72)) (do_H))                  ;;; H key
  82.     ((equal code '(2 73)) (do_I))                  ;;; I key
  83.     ((equal code '(2 74)) (do_J))                  ;;; J key
  84.     ((equal code '(2 75)) (do_K))                  ;;; K key
  85.     ((equal code '(2 76)) (do_L))                  ;;; L key
  86.     ((equal code '(2 77)) (do_M))                  ;;; M key
  87.     ((equal code '(2 78)) (do_N))                  ;;; N key
  88.     ((equal code '(2 79)) (do_O))                  ;;; O key
  89.     ((equal code '(2 80)) (do_P))                  ;;; P key
  90.     ((equal code '(2 81)) (do_Q))                  ;;; Q key
  91.     ((equal code '(2 82)) (do_R))                  ;;; R key
  92.     ((equal code '(2 83)) (do_S))                  ;;; S key
  93.     ((equal code '(2 84)) (do_T))                  ;;; T key
  94.     ((equal code '(2 85)) (do_U))                  ;;; U key
  95.     ((equal code '(2 86)) (do_V))                  ;;; V key
  96.     ((equal code '(2 87)) (do_W))                  ;;; W key
  97.     ((equal code '(2 88)) (do_X))                  ;;; X key
  98.     ((equal code '(2 89)) (do_Y))                  ;;; Y key
  99.     ((equal code '(2 90)) (do_Z))                  ;;; Z key
  100.     ((equal code '(2 91)) (do_OpenSquareBracket))  ;;; [ key
  101.     ((equal code '(2 92)) (do_BackSlash))          ;;; \ key
  102.     ((equal code '(2 93)) (do_CloseSquareBracket)) ;;; ] key
  103.     ((equal code '(2 94)) (do_Caret))              ;;; ^ key
  104.     ((equal code '(2 95)) (do_UnderScore))         ;;; _ key
  105.     ((equal code '(2 96)) (do_BackQuote))          ;;; ` key
  106.     ((equal code '(2 97)) (do_a))                  ;;; a key
  107.     ((equal code '(2 98)) (do_b))                  ;;; b key
  108.     ((equal code '(2 99)) (do_c))                  ;;; c key
  109.     ((equal code '(2 100))(do_d))                  ;;; d key
  110.     ((equal code '(2 101))(do_e))                  ;;; e key
  111.     ((equal code '(2 102))(do_f))                  ;;; f key
  112.     ((equal code '(2 103))(do_g))                  ;;; g key
  113.     ((equal code '(2 104))(do_h))                  ;;; h key
  114.     ((equal code '(2 105))(do_i))                  ;;; i key
  115.     ((equal code '(2 106))(do_j))                  ;;; j key
  116.     ((equal code '(2 107))(do_k))                  ;;; k key
  117.     ((equal code '(2 108))(do_l))                  ;;; l key
  118.     ((equal code '(2 109))(do_m))                  ;;; m key
  119.     ((equal code '(2 110))(do_n))                  ;;; n key
  120.     ((equal code '(2 111))(do_o))                  ;;; o key
  121.     ((equal code '(2 112))(do_p))                  ;;; p key
  122.     ((equal code '(2 113))(do_q))                  ;;; q key
  123.     ((equal code '(2 114))(do_r))                  ;;; r key
  124.     ((equal code '(2 115))(do_s))                  ;;; s key
  125.     ((equal code '(2 116))(do_t))                  ;;; t key
  126.     ((equal code '(2 117))(do_u))                  ;;; u key
  127.     ((equal code '(2 118))(do_v))                  ;;; v key
  128.     ((equal code '(2 119))(do_w))                  ;;; w key
  129.     ((equal code '(2 120))(do_x))                  ;;; x key
  130.     ((equal code '(2 121))(do_y))                  ;;; y key
  131.     ((equal code '(2 122))(do_z))                  ;;; z key
  132.     ((equal code '(2 123))(do_OpenBrace))          ;;; { key
  133.     ((equal code '(2 124))(do_VerticalBar))        ;;; | key
  134.     ((equal code '(2 125))(do_CloseBrace))         ;;; } key
  135.     ((equal code '(2 126))(do_Tilde))              ;;; ~ key
  136.     ((equal code '(2 127))(do_Delete))             ;;; Delete key
  137.  )
  138. )
« Last Edit: December 23, 2011, 05:31:58 AM by FreeBird »

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #173 on: December 22, 2011, 09:55:09 AM »
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

MP

  • Seagull
  • Posts: 17630
Re: Examples of usage GRREAD - let's share
« Reply #174 on: December 22, 2011, 10:16:28 AM »
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

trogg

  • Bull Frog
  • Posts: 248
Re: Examples of usage GRREAD - let's share
« Reply #175 on: December 22, 2011, 12:37:21 PM »
Dynamic Arrow Size:
Nice one Alan. This will be very helpful
~Greg

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #176 on: December 22, 2011, 01:00:10 PM »
Dynamic Arrow Size:
Nice one Alan. This will be very helpful
~Greg
enjoy.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

HasanCAD

  • Swamp Rat
  • Posts: 1326
Re: Examples of usage GRREAD - let's share
« Reply #177 on: March 12, 2012, 06:11:29 AM »
Quote
Code: [Select]
[quote author=Lee Mac link=topic=12813.msg440380#msg440380 date=1310689668]
Some fun with
...
Combining the two

 :-)

- The Osnap not working to pick the second point. I know that Osnap not Working with GRerad. But I am sure that LEE has a solution
- Is there an ability to insert a block in start and end point of lines. no need for lines

Thanks LEE
« Last Edit: March 12, 2012, 06:35:12 AM by HasanCAD »

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #178 on: June 12, 2012, 11:52:33 AM »
A short, quick example to add to the collection:



Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / a1 a2 p1 p2 pl )
  2.     (if (setq p1 (getpoint "\nPick 1st Point: "))
  3.         (progn
  4.             (setq a1 (* pi 0.05)
  5.                   a2 (* pi  1.5)    
  6.             )
  7.             (repeat 10
  8.                 (setq pl (cons (polar '(0.0 2.0 0.0) a2 2.0) pl)
  9.                       a2 (+ a2 a1)
  10.                 )
  11.             )
  12.             (setq pl (apply 'append (mapcar 'list pl (cdr pl))))
  13.             (princ "\nPick 2nd Point: ")
  14.             (while (= 5 (car (setq p2 (grread nil 13 0))))
  15.                 (setq p2 (cadr p2)
  16.                       a1 (angle p1 p2)
  17.                 )
  18.                 (redraw)
  19.                 (grvecs (list 3 p1 p2))
  20.                 (grvecs (cons 3 pl)
  21.                     (list
  22.                         (list (cos a1) (- (sin a1)) 0.0 (car  p2))
  23.                         (list (sin a1)    (cos a1)  0.0 (cadr p2))
  24.                        '(0.0 0.0 1.0 0.0)
  25.                        '(0.0 0.0 0.0 1.0)
  26.                     )
  27.                 )
  28.             )
  29.         )
  30.     )
  31.     (redraw) (princ)
  32. )

hmspe

  • Bull Frog
  • Posts: 339
Re: Examples of usage GRREAD - let's share
« Reply #179 on: July 15, 2012, 11:22:00 PM »
I have a routine the requires selection of a single text entity.  Getting custom prompts to work correctly in both Autocad and Bricscad with the native commands has not been going well, and ssget only recognizes the outline of each character.

This function allows for custom prompts and does rollover highlighting of text entities based on the the aligned bounding box for the text entity.



Code: [Select]
(defun c:select_text (/ dim_scale half_pi loop new_entity old_entity
                      ret_val two_pi
                     )

  (defun get_text (cursor_point offset_distance filter / angle1 angle2         ; gets text using a bounding box
                   base_angle base_point box entity LL point1 point2
                   selset text_ename text_height UR
                  )

    (defun delta (a1 a2 / r1)                                                  ; gets the absolute angle between two vectors
      (cond ((> a1 (+ a2 pi)) (setq a2 (+ a2 two_pi)))                         ; based on code by John Uhden
            ((> a2 (+ a1 pi)) (setq a1 (+ a1 two_pi)))
      )
      (setq r1 (- a2 a1))
      (if (< r1 0.0)
        (setq r1 (+ r1 two_pi))
      )
      r1
    )

    (if (vl-string-search "BRICSCAD" (strcase (getvar "acadver")))             ; Bricscad does not like really small selection windows
      (if (< offset_distance 0.001) (setq offset_distance 0.001))
    )
    (setq selset (ssget "c"                                                    ; get the text entities at the cursor
                   (list (- (car cursor_point) offset_distance) (- (cadr cursor_point) offset_distance))
                   (list (+ (car cursor_point) offset_distance) (+ (cadr cursor_point) offset_distance))
                   filter
                 )
    )
    (setq counter    0
          text_ename nil
    )
    (if selset
      (progn
        (setq entity      (entget (ssname selset 0))                           ; just look at first entity
              text_height (cdr (assoc 40 entity))
              base_angle  (cdr (assoc 50 entity))
              base_point  (cdr (assoc 10 entity))
              box    (textbox entity)                                          ; get the normalized containing box
              point1 (car box)                                                 ; normalized LL point
              point2 (cadr box)                                                ; normalized UR point
              LL  (polar (trans (cdr (assoc 10 entity)) 0 1)                   ; actual LL point
                         (+ (angle '(0 0) point1) base_angle)
                         (distance '(0 0) point1)
                  )
              UR  (polar LL                                                    ; actual UR point
                         (+ base_angle (angle point1 point2))
                         (distance point1 point2)
                  )
              angle1 (delta base_angle (angle LL cursor_point))                ; angle from LL to cursor
              angle2 (delta base_angle (angle UR cursor_point))                ; from UL to cursor
        )
        (if (and (>= angle1 0.0)                                               ; test if the cursor is in the included
                 (<= angle1 half_pi)                                           ;   angle at the LL and UL
                 (>= angle2 pi)
                 (<= angle2 (+ pi half_pi))
            )
          (setq text_ename (cdr (assoc -1 entity)))                            ; return the text's ename
        )
        (setq counter (1+ counter))
      )
    )
    text_ename
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq old_entity nil
        new_entity nil
        loop       T
        dim_scale (getvar "dimscale")
  )
  (setq half_pi       (* PI 0.5)
        two_pi        (* PI 2.0)
  )
  (princ "\rSelect text: ")
  (while loop
    (setq ret_val (car (setq gr_data (grread t 15 2))))
    (cond ((= ret_val 5)
             (setq new_entity (get_text (cadr gr_data) (* dim_scale 0.05) '((0 . "TEXT"))))
                                                                               ; get text entities at the cursor
             (if (/= new_entity old_entity)                                    ; the entity has changed...
               (if new_entity                                                  ; if the new entity is not nil...
                 (redraw new_entity 3)                                         ; highlight the new entity
                 (if old_entity
                   (redraw old_entity 4)                                       ; unhighlight the old entity
                 )
               )
             )
             (setq old_entity new_entity)                                      ; store the last entity
          )
          ((= ret_val 3)
             (setq loop nil)
          )
    )
  )
  (if new_entity                                                               ; if the new entity is not nil...
    (redraw new_entity 4)                                                      ; highlight the new entity
  )
  (print new_entity)                                                           ; return the entity's ename
  (princ)
)


"Science is the belief in the ignorance of experts." - Richard Feynman