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

0 Members and 1 Guest are viewing this topic.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Examples of usage GRREAD - let's share
« on: October 08, 2006, 12:29:39 PM »
At this forum, many programs with usage of function GRREAD are published, but I have decided to show some more simple, from the stores...
I hope, you too show the variants.  :-)

Drawing of a line under a corner of 45 degrees

Code: [Select]
(defun line<45 (/ GR LST PT)
  ; Drawing of a line under a corner of 45 degrees
  ; by ElpanovEvgeniy
  ; (2005-03-22 10:43:02)
  ;(line<45)
  (setq lst (entget
              (entmakex
                (list
                  '(0 . "LINE")
                  (cons 8 (getvar "CLAYER"))
                  (cons 10 (setq pt (getpoint "\n Specify the first point  ")))
                  (cons 11 pt)
                ) ;_  list
              ) ;_  entmakex
            ) ;_  entget
  ) ;_  setq
  (princ "\n Specify the second point  ")
  (while (and (setq gr (grread 5)) (= (car gr) 5))
    (entmod (subst
              (cons 11 (polar pt (/ pi 4) (distance pt (cadr gr))))
              (assoc 11 lst)
              lst
            ) ;_  subst
    ) ;_  entmod
    (entupd (cdr (assoc -1 lst)))
  ) ;_  while
) ;_  defun


Change of radius of an arc

Code: [Select]
(defun arc-radius (/ GR LST PT)
  ; Change of radius of an arc
  ; by ElpanovEvgeniy
  ; (2005-03-22 11:21:30)
  ;(arc-radius)
  (setq lst (entget
              (car (entsel "\n Select an arc  "))
            ) ;_  entget
        pt  (cdr (assoc 10 lst))
  ) ;_  setq
  (princ "\n Select new radius  ")
  (while (and (setq gr (grread 5)) (= (car gr) 5))
    (entmod (subst
              (cons 40 (distance pt (cadr gr)))
              (assoc 40 lst)
              lst
            ) ;_  subst
    ) ;_  entmod
    (entupd (cdr (assoc -1 lst)))
  ) ;_  while
) ;_  defun

Sequential choice of points

Code: [Select]
(defun VECTORS (/ PT PTLIST)
  ; Sequential choice of points
  ; by ElpanovEvgeniy
  ; (2005-10-19 17:59:01)
  ; (VECTORS)
  (setq PTLIST (list
                 (setq PT (getpoint "\n Specify the first point  "))
               ) ;_  list
  ) ;_  setq
  (princ "\n Specify the following point  ")
  (princ)
  (while
    (setq PT
           (progn (while
                    (and (setq PT (grread 5))
                         (= (car PT) 5)
                    ) ;_  and
                     (redraw)
                     (mapcar
                       (function
                         (lambda (x1 x2)
                           (grdraw x1 x2 6 5)
                         ) ;_  lambda
                       ) ;_  function
                       (cons (cadr PT) PTLIST)
                       PTLIST
                     ) ;_  mapcar
                  ) ;_  while
                  (if (listp (cadr PT))
                    (cadr PT)
                  ) ;_  if
           ) ;_  progn
    ) ;_  setq
     (setq PTLIST (cons PT PTLIST))
  ) ;_  while
) ;_  defun

Clone Select CP

Code: [Select]
(defun lst-ent-wp (/ PT PTLIST SS)
  ; Clone Select CP
  ; by ElpanovEvgeniy
  ; (2006-05-11 11:05:52)
  ; (lst-ent-wp)
  (setq
    PTLIST (list (setq PT (getpoint "\n Specify the first point  ")))
  ) ;_  setq
  (princ "\n Specify the following point  ")
  (princ)
  (while
    (setq
      PT (progn
           (while
             (and
               (setq PT (grread 5))
               (= (car PT) 5)
             ) ;_  and
              (redraw)
              (mapcar
                (function
                  (lambda (x1 x2)
                    (grdraw x1 x2 6 5)
                  ) ;_  lambda
                ) ;_  function
                (cons (cadr PT) PTLIST)
                (append PTLIST (cdr PT))
              ) ;_  mapcar
           ) ;_  while
           (if (listp (cadr PT))
             (cadr PT)
           ) ;_  if
         ) ;_  progn
    ) ;_  setq
     (setq PTLIST (cons PT PTLIST))
  ) ;_  while
  (redraw)
  (vla-ZoomExtents (vlax-get-acad-object))
  (if (setq ss (ssget "CP" PTLIST))
    (vl-remove-if
      (function listp)
      (mapcar (function cadr) (ssnamex ss))
    ) ;_  vl-remove-if
  ) ;_  if
) ;_  defun

Example of usage of various matrixes in LISP

Code: [Select]
(defun c:test (/ A LST P P1 S X Y)
  ; Example of usage of various matrixes in LISP
  ; by ElpanovEvgeniy
  ; (2006-10-01)
  ; (c:test)
  (setq lst '((0. 0.) (0. 1.) (1. 1.) (1. 0.))
        p1  (trans (setq p (getpoint "\n Get base point")) 1 3)
        x   (car p1)
        y   (cadr p1)
  ) ;_  setq
  (while (= (car (setq p (grread nil 5))) 5)
    (setq p (trans (cadr p) 1 3)
          p (list (- (car p) x) (- (cadr p) y))
          a 0. ;(angle p1 p)
          s (/ (getvar "viewsize") 10.)
    ) ;_  setq
    (if (> (abs (car p)) (abs (cadr p)))
      (setq p (list
                (if (minusp (car p))
                  -1.
                  1.
                ) ;_  if
                (if (zerop (car p))
                  0.
                  (/ (cadr p) (abs (car p)))
                ) ;_  if
              ) ;_  list
      ) ;_  setq
      (setq p (list
                (if (zerop (cadr p))
                  0.
                  (/ (car p) (abs (cadr p)))
                ) ;_  if
                (if (minusp (cadr p))
                  -1.
                  1.
                ) ;_  if
              ) ;_  list
      ) ;_  setq
    ) ;_  if
    (redraw)
    (grvecs
      (apply
        (function append)
        (cons (list 3 '(0 0) p)
              (mapcar
                (function
                  (lambda (l)
                    (apply
                      (function append)
                      (mapcar
                        (function
                          (lambda (x x1) (list 1 x x1))
                        ) ;_  function
                        l
                        (cons (last l) l)
                      ) ;_  mapcar
                    ) ;_  apply
                  ) ;_  lambda
                ) ;_  function
                (mapcar
                  (function
                    (lambda (n)
                      (setq
                        n (list
                            (+ (* (car n) (car p)) (* (cadr n) (cadr p)))
                            (+ (* (car n) (cadr p)) (* (cadr n) (- (car p))))
                          ) ;_  list
                      ) ;_  setq
                      (mapcar (function (lambda (x1) (mapcar (function +) x1 n))) lst)
                    ) ;_  lambda
                  ) ;_  function
                '((-2 -2)(-1 -2)(0 -2)(1 -2)(2 -2)
                  (-2 -1)(-1 -1)(0 -1)(1 -1)(2 -1)
                  (-2  0)(-1  0)(0  0)(1  0)(2  0)
                  (-2  1)(-1  1)(0  1)(1  1)(2  1)
                  (-2  2)(-1  2)(0  2)(1  2)(2  2)
                 )
                ) ;_  mapcar
              ) ;_  mapcar
        ) ;_  cons
      ) ;_  apply
      (list
        (list (* (cos a) s) (* (- (sin a)) s) 0. (- (+ x x) (* x (cos a)) (* y (- (sin a)))))
        (list (* (sin a) s) (* (cos a) s) 0. (- (+ y y) (* x (sin a)) (* y (cos a))))
        (list 0. 0. s 0.)
        '(0. 0. 0. 1.)
      ) ;_  list
    ) ;_  grvecs
  ) ;_  while
  (redraw)
) ;_  defun
« Last Edit: October 08, 2006, 01:12:23 PM by ElpanovEvgeniy »
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: Examples of usage GRREAD - let's share
« Reply #1 on: October 08, 2006, 01:07:06 PM »
Has found two more programs which are not published at this forum...
 :-)

Addition of a point in a polyline

Code: [Select]
(defun C:LW_pt (/ ENT I LST LW PAR PT)
  ; Addition of a point in a polyline
  ; by ElpanovEvgeniy
  ; (2005-11-09 15:05:39)
  ; (C:LW_pt)
  (setq pt (getpoint " \n Specify a new point polylines. "))
  (if (and pt (setq lw (ssget pt '((0 . "LWPOLYLINE")))) (setq lw (ssname lw 0)))
    (progn
      (setq par (vlax-curve-getParamAtPoint lw (vlax-curve-getClosestPointTo lw pt))
            ent (entget lw)
            ent (subst (cons 90 (1+ (cdr (assoc 90 ent)))) (assoc 90 ent) ent)
            i   0
            lst nil
      ) ;_  setq
      (while (or (/= (caar ent) 41)
                 (if (< i (fix par))
                   (setq i (1+ i))
                 ) ;_  if
             ) ;_  or
        (setq lst (cons (car ent) lst)
              ent (cdr ent)
        ) ;_  setq
      ) ;_  while
      (setq lst (cons (cons 41
                            (+ (cdr (assoc 40 lst))
                               (* (- (cdr (assoc 41 ent)) (cdr (assoc 40 lst))) (- par (fix par)))
                            ) ;_  +
                      ) ;_  cons
                      lst
                ) ;_  cons
            lst (cons (cons 42
                            (/ (sin (setq i
                                           (- (angle (vlax-curve-getPointAtParam lw (fix par)) pt)
                                              (angle
                                                (vlax-curve-getPointAtParam lw (fix par))
                                                (vlax-curve-getPointAtParam lw (+ (fix par) (/ (- par (fix par)) 2.)))
                                              ) ;_  angle
                                           ) ;_  -
                                    ) ;_  setq
                               ) ;_  sin
                               (cos i)
                            ) ;_  /
                      ) ;_  cons
                      lst
                ) ;_  cons
            lst (cons (assoc 41 ent)
                      (cons (cons 40 (cdr (assoc 41 lst))) (cons (list 10 (car pt) (cadr pt)) lst))
                ) ;_  cons
            lst (cons
                  (cons
                    42
                    (/
                      (sin (setq
                             i (- (angle pt (vlax-curve-getPointAtParam lw (1+ (fix par))))
                                  (angle
                                    pt
                                    (vlax-curve-getPointAtParam lw (+ par (/ (- (1+ (fix par)) par) 2.)))
                                  ) ;_  angle
                               ) ;_  -
                           ) ;_  setq
                      ) ;_  sin
                      (cos i)
                    ) ;_  /
                  ) ;_  cons
                  lst
                ) ;_  cons
      ) ;_  setq
      (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
      (entmod (append (reverse lst) (cddr ent)))
      (entupd lw)
      (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_  progn
    (princ " \n Specified point does not lay on a polyline. ")
  ) ;_  if
  (princ)
) ;_  defun

Addition of a point in a lwpolyline, line, arc, circle

Code: [Select]
(defun c:lw_pt_1 (/ ent i gr lst lw par pt)
  ; Addition of a point in a lwpolyline, line, arc, circle
  ; by ElpanovEvgeniy
  ; (2005-11-10 12:48:04)
  ; (c:lw_pt_1)
  (princ " \n Specify a new point polylines. ")
  (while (and (setq gr (grread 5)) (= (car gr) 5))
    (if lw
      (redraw lw 4)
    ) ;_  if
    (if (and (setq pt (osnap (cadr gr) "_nea,_end"))
             (setq lw (ssget pt '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE"))))
             (setq lw (ssname lw 0))
             (setq ent (entget lw))
        ) ;_  and
      (redraw lw 3)
    ) ;_  if
  ) ;_  while
  (cond
    ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
     (setq par (vlax-curve-getparamatpoint
                 lw
                 (vlax-curve-getclosestpointto
                   lw
                   pt
                 ) ;_  vlax-curve-getclosestpointto
               ) ;_  vlax-curve-getparamatpoint
           ent (subst (cons 90 (1+ (cdr (assoc 90 ent))))
                      (assoc 90
                             ent
                      ) ;_  assoc
                      ent
               ) ;_  subst
           i   0
           lst nil
     ) ;_  setq
     (if (/= par (fix par))
       (progn (while (or (/= (caar ent) 41)
                         (if (< i (fix par))
                           (setq i (1+ i))
                         ) ;_  if
                     ) ;_  or
                (setq lst (cons (car ent) lst)
                      ent (cdr ent)
                ) ;_  setq
              ) ;_  while
              (setq lst (cons
                          (cons
                            41
                            (+ (cdr (assoc 40 lst))
                               (* (- (cdr (assoc 41 ent)) (cdr (assoc 40 lst)))
                                  (-
                                    par
                                    (fix par)
                                  ) ;_  -
                               ) ;_  *
                            ) ;_  +
                          ) ;_  cons
                          lst
                        ) ;_  cons
                    lst (cons
                          (cons
                            42
                            (/
                              (sin
                                (setq i (-
                                          (angle
                                            (vlax-curve-getpointatparam
                                              lw
                                              (fix par)
                                            ) ;_  vlax-curve-getpointatparam
                                            pt
                                          ) ;_  angle
                                          (angle (vlax-curve-getpointatparam lw (fix par))
                                                 (vlax-curve-getpointatparam
                                                   lw
                                                   (+ (fix par)
                                                      (/ (-
                                                           par
                                                           (fix par)
                                                         ) ;_  -
                                                         2.
                                                      ) ;_  /
                                                   ) ;_  +
                                                 ) ;_  vlax-curve-getpointatparam
                                          ) ;_  angle
                                        ) ;_  -
                                ) ;_  setq
                              ) ;_  sin
                              (cos i)
                            ) ;_  /
                          ) ;_  cons
                          lst
                        ) ;_  cons
                    lst (cons (assoc 41 ent)
                              (cons (cons 40 (cdr (assoc 41 lst)))
                                    (cons (list 10 (car pt) (cadr pt))
                                          lst
                                    ) ;_  cons
                              ) ;_  cons
                        ) ;_  cons
                    lst (cons
                          (cons
                            42
                            (/
                              (sin
                                (setq
                                  i (-
                                      (angle pt
                                             (vlax-curve-getpointatparam
                                               lw
                                               (1+ (fix par))
                                             ) ;_  vlax-curve-
                                      ) ;_  angle
                                      (angle pt
                                             (vlax-curve-getpointatparam
                                               lw
                                               (+ par
                                                  (/ (-
                                                       (1+ (fix par))
                                                       par
                                                     ) ;_  -
                                                     2.
                                                  ) ;_  /
                                               ) ;_  +
                                             ) ;_  vlax-curve-getpointatparam
                                      ) ;_  angle
                                    ) ;_  -
                                ) ;_  setq
                              ) ;_  sin
                              (cos i)
                            ) ;_  /
                          ) ;_  cons
                          lst
                        ) ;_  cons
              ) ;_  setq
              (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
              (entmod (append (reverse lst) (cddr ent)))
              (entupd lw)
              (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
       ) ;_  progn
     ) ;_  if
     (vl-cmdf
       "_.stretch"
       "_C"
       pt
       pt
       ""
       pt
       (getpoint pt " Specify a new point: ")
     ) ;_  vl-cmdf
    )
    ((= (cdr (assoc 0 ent)) "LINE")
     (setq lst '((0 . "LWPOLYLINE")))
     (foreach x '(100 67 410 8 62 6 370)
       (if (assoc x ent)
         (setq lst (cons (assoc x ent) lst))
       ) ;_  if
     ) ;_  foreach
     (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
     (entmakex
       (append (reverse lst)
               (list '(100 . "AcDbPolyline")
                     '(90 . 3)
                     '(70 . 0)
                     (cons 38 (cadddr (assoc 10 ent)))
                     (assoc 10 ent)
                     '(40 . 0)
                     '(41 . 0)
                     '(42 . 0)
                     (cons 10 (list (car pt) (cadr pt)))
                     '(40 . 0)
                     '(41 . 0)
                     '(42 . 0)
                     (cons 10
                           (list (cadr (assoc 11 ent))
                                 (caddr (assoc 11
                                               ent
                                        ) ;_  assoc
                                 ) ;_  caddr
                           ) ;_  list
                     ) ;_  cons
                     '(40 . 0)
                     '(41 . 0)
                     '(42 . 0)
                     (assoc 210 ent)
               ) ;_  list
       ) ;_  append
     ) ;_  entmakex
     (entdel lw)
     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
     (vl-cmdf "_.stretch"
              "_C"
              pt
              pt
              ""
              pt
              (getpoint pt " Specify a new point: ")
     ) ;_  vl-cmdf
    )
    ((= (cdr (assoc 0 ent)) "ARC")
     (setq lst '((0 . "LWPOLYLINE"))
           par (vlax-curve-getparamatpoint
                 lw
                 (vlax-curve-getclosestpointto
                   lw
                   pt
                 ) ;_  vlax-curve-
               ) ;_  vlax-curve-getparamatpoint
     ) ;_  setq
     (foreach x '(100 67 410 8 62 6 370)
       (if (assoc x
                  ent
           ) ;_  assoc
         (setq lst (cons (assoc x ent) lst))
       ) ;_  if
     ) ;_  foreach
     (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
     (entmakex
       (append
         (reverse lst)
         (list
           '(100 . "AcDbPolyline")
           '(90 . 3)
           '(70 . 0)
           (cons 38 (cadddr (assoc 10 ent)))
           (cons
             10
             (reverse
               (cdr
                 (reverse
                   (polar
                     (cdr
                       (assoc 10 ent)
                     ) ;_  cdr
                     (cdr (assoc 50 ent))
                     (cdr (assoc 40 ent))
                   ) ;_  polar
                 ) ;_  reverse
               ) ;_  cdr
             ) ;_  reverse
           ) ;_  cons
           '(40 . 0)
           '(41 . 0)
           (cons
             42
             (/
               (sin
                 (setq i (-
                           (angle
                             (vlax-curve-getstartpoint lw)
                             pt
                           ) ;_  angle
                           (angle
                             (vlax-curve-getstartpoint lw)
                             (vlax-curve-getpointatparam
                               lw
                               (+ (vlax-curve-getstartparam lw)
                                  (/
                                    (- par
                                       (vlax-curve-getstartparam
                                         lw
                                       ) ;_  vlax-curve-
                                    ) ;_  -
                                    2.
                                  ) ;_  /
                               ) ;_  +
                             ) ;_  vlax-curve-getpointatparam
                           ) ;_  angle
                         ) ;_  -
                 ) ;_  setq
               ) ;_  sin
               (cos i)
             ) ;_  /
           ) ;_  cons
           (cons 10 (list (car pt) (cadr pt)))
           '(40 . 0)
           '(41 . 0)
           (cons 42
                 (/ (sin
                      (setq i (-
                                (angle pt (vlax-curve-getendpoint lw))
                                (angle pt
                                       (vlax-curve-getpointatparam
                                         lw
                                         (+ par
                                            (/ (-
                                                 (vlax-curve-getendparam lw)
                                                 par
                                               ) ;_  -
                                               2.
                                            ) ;_  /
                                         ) ;_  +
                                       ) ;_  vlax-curve-getpointatparam
                                ) ;_  angle
                              ) ;_  -
                      ) ;_  setq
                    ) ;_  sin
                    (cos i)
                 ) ;_  /
           ) ;_  cons
           (cons
             10
             (reverse
               (cdr
                 (reverse
                   (polar
                     (cdr
                       (assoc
                         10
                         ent
                       ) ;_  assoc
                     ) ;_  cdr
                     (cdr (assoc 51 ent))
                     (cdr (assoc 40 ent))
                   ) ;_  polar
                 ) ;_  reverse
               ) ;_  cdr
             ) ;_  reverse
           ) ;_  cons
           '(40 . 0)
           '(41 . 0)
           '(42 . 0)
           (assoc 210 ent)
         ) ;_  list
       ) ;_  append
     ) ;_  entmakex
     (entdel lw)
     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
     (vl-cmdf "_.stretch"
              "_C"
              pt
              pt
              ""
              pt
              (getpoint pt " Specify a new point: ")
     ) ;_  vl-cmdf
    )
    ((= (cdr (assoc 0 ent)) "CIRCLE")
     (setq lst '((0 . "LWPOLYLINE")))
     (foreach x '(100 67 410 8 62 6 370)
       (if (assoc x ent)
         (setq lst (cons (assoc x ent) lst))
       ) ;_  if
     ) ;_  foreach
     (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
     (entmakex
       (append (reverse lst)
               (list '(100 . "AcDbPolyline")
                     '(90 . 2)
                     '(70 . 1)
                     (cons 38 (cadddr (assoc 10 ent)))
                     (cons 10 (list (car pt) (cadr pt)))
                     '(40 . 0)
                     '(41 . 0)
                     (cons 42 (/ (sin (/ pi 4.)) (cos (/ pi 4.))))
                     (cons 10
                           (reverse
                             (cdr (reverse (polar (cdr (assoc 10 ent))
                                                  (angle
                                                    pt
                                                    (cdr (assoc 10 ent))
                                                  ) ;_  angle
                                                  (cdr (assoc 40 ent))
                                           ) ;_  polar
                                  ) ;_  reverse
                             ) ;_  cdr
                           ) ;_  reverse
                     ) ;_  cons
                     '(40 . 0)
                     '(41 . 0)
                     '(42 . 1.)
                     (assoc 210 ent)
               ) ;_  list
       ) ;_  append
     ) ;_  entmakex
     (entdel lw)
     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
     (vl-cmdf "_.stretch"
              "_C"
              pt
              pt
              ""
              pt
              (getpoint pt " Specify a new point: ")
     ) ;_  vl-cmdf
    )
    (t (princ " \n Specified point does not lay on a polyline or line, arc, circle... "))
  ) ;_  cond
  (princ)
) ;_  defun
« Last Edit: October 08, 2006, 01:14:45 PM by ElpanovEvgeniy »
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Crank

  • Swamp Rat
  • Posts: 1441
Re: Examples of usage GRREAD - let's share
« Reply #2 on: October 08, 2006, 02:38:53 PM »
Do you mean GRREAD or GRDRAW? :D

Here is a function I call after the STRETCH command:
Code: [Select]
(defun rc (/ p1 p2 p3 p4 a g om)
(setq om (getvar "OSMODE"))(setvar "OSMODE" 0)
(setq p1 (getpoint "\nSelect objects to stretch by (rotated) crossing..."))

(princ "\nOther corner...")
(while (not a)
(setq g (grread T) p3 (cadr g))
(cond ((= (car g) 3) ; PICK BUTTON?
(setq a T)
(redraw)
)
((= (car g) 5) ; POSITIE?
(setq p2 (list (car p1)(cadr p3)))
(setq p4 (list (car p3)(cadr p1)))
(redraw)(grvecs (list -256 p1 p2 p2 p3 p3 p4 p4 p1))
)
)
)
(setvar "OSMODE" om)
(ssget "CP" (list p1 p2 p3 p4))
)
I never understood why the box of a crossing or window doesn't follow the angle of the UCS.

 Vault Professional 2018     /      Building Design Suite Ultimate 2017     /     AEC Collection 2018 + 2019 +2020

MickD

  • Gator
  • Posts: 3314
  • (x-in)->[process]->(y-out)
Re: Examples of usage GRREAD - let's share
« Reply #3 on: October 08, 2006, 06:56:36 PM »
....
I never understood why the box of a crossing or window doesn't follow the angle of the UCS.


A lot of it has to do with the graphics api (not AutoCAD but the OpenGL/DirectX api's). In order for the application to get feedback from the user, the application feeds the graphics api a 'pick box' which can vary in size from the std pick box used by autocad (say 4 pixels square) to a selection window of given size by the user.
Now, given this pick box the application has to tell the grfx api to go into selection mode which creates a selection buffer, the grfx api then clips out any geometry (pixels) outside the box and returns a 'hit list' containing id numbers of the primitives which are mapped to autocad primitives that make up more complex objects, this way Autocad can find out what was selected and let you modify them.
You can see now how complex it could get if you tried to capture pixels in any direction but 'square' to the screen.
A work around could be to grab the rectangle and the model/scene and transform it to be square, do the selection thing and invert it back but there may be some subtle inaccuracies with doing this not to mention a performance hit.
hth,
Mick.
Forth is like the Tao: it is a Way, and is realized when followed.
Its fragility is its strength; its simplicity is its direction - Michael Ham

Lao Tzu: “To attain knowledge, add things
every day; to obtain wisdom, remove things every day.”

daron

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #4 on: October 09, 2006, 08:21:58 AM »
Quite a bit for me, Mick. Thanks.

sinc

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #5 on: October 09, 2006, 09:52:08 AM »

You can see now how complex it could get if you tried to capture pixels in any direction but 'square' to the screen.
A work around could be to grab the rectangle and the model/scene and transform it to be square, do the selection thing and invert it back but there may be some subtle inaccuracies with doing this not to mention a performance hit.

Are you really sure about all this, or is it a lot of guesswork?

You can always type WP or CP at the "Select Objects" prompt, and select any irregular selection area you want.  The selection area can be pretty convoluted.  If it's possible to easily select any irregular area like that, why would it be any harder to create a rectangular box oriented with, say, the SNAPANG?

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: Examples of usage GRREAD - let's share
« Reply #6 on: October 09, 2006, 04:34:54 PM »

Do you mean GRREAD or GRDRAW? :D


I meant GRREAD!
Actually, it can be used in greater quantity cases, than it is done by me....
I would like to see various variants of application :-)
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

GDF

  • Water Moccasin
  • Posts: 2000
Re: Examples of usage GRREAD - let's share
« Reply #7 on: October 09, 2006, 05:08:05 PM »
Not sure of this one, I think it uses grread...anyway it is a kool routine.

..google it..

Code: [Select]

                                K4KUBE.TXT
                                ==========

                      Freeware Version 1.01 of K4KUBE

                   Copyright (C) 2002,  K4 CAD Solutions


WELCOME TO K4KUBE
===============================================================================

K4KUBE is a free RUBIK'S CUBE game for AutoCAD (R12, R13, R14, 2000, 2002).

K4KUBE comes as a zipped file (A_RUBIX.ZIP) which unzips into two files:

K4KUBE.TXT  - This File.
K4KUBE.LSP  - An AutoLISP program to play
              R U B I K ' S   C U B E.


INSTALLING K4KUBE
===============================================================================

1) Create a new directory with the path C:\K4KUBE (or any other name).
2) Unzip A_RUBIX.ZIP which expands into the two files listed above.


RUNNING K4KUBE
===============================================================================

Using the AutoCAD Menus, select 'Tools', then 'Load Application...', then
select K4KUBE.LSP from the folder which you installed into. Click on
'Load' then verify that it loaded successfully.

OR,  at the AutoCAD command prompt type:

     (load "c:/k4kube/k4kube")     [Note: use forward slashes].

     If you have installed K4KUBE into a different directory or folder than
     the one above, eg. C:\Program Files\K4kube then type:

     (load "c:/program files/k4kube/k4kube")

OR,  for easier loading copy the file K4KUBE.LSP somewhere into the AutoCAD
     support path and then type:

     (load "k4kube")

Alternatively, the AutoLISP File K4KUBE.LSP may be loaded by double clicking
on it via Windows Explorer.


Once loaded, the command K4KUBE runs automatically.

Click on Large Arrows to turn the cube.
Click on Small Arrows to turn a layer.
Click on buttons to:  MIX  (10 random twists)
                      SORT (resets cube)
                      QUIT (quits K4KUBE, remembers last permutation)
The command K4KUBE be run at any time from the Command Bar.


NOTE: If running in IntelliCAD type:

     (setq k4icad 1)

      at the command prompt.

  OR,

      Create a new file called 'K4KUBE-P.LSP' containing:

      (setq k4icad 1)
      (load "c:/k4kube/k4kube")  ;;modify to your installation path

      Finally, to run K4KUBE type:

      (load "c:/k4kube/k4kube-p")


ABOUT K4 CAD SOLUTIONS
===============================================================================

K4 CAD Solutions develops bespoke software for AutoCAD (and Windows) to meet
very specific user-requirements that are often not fully addressed by 'off
the shelf packages'.  Examples of the types of projects undertaken include:

     Parametric Commands : Commands to automate the drawing of complicated
                           designs simply by specifying dimensions of the
                           features within the design.  Use of dialogue boxes
                           enables fast and accurate data entry.

 Manufacturers Databases : Suites of commands that interactively display then
                           insert your company's manufactured products into
                           drawings - for use in-house or for distribution to
                           engineers, architects and specifiers.

     CNC Code Generators : Commands to draw machined parts and automatically
                           generate CNC code to your exact specifications.
                           G CODE turning and milling projects undertaken.

For more information regarding the services on offer or to discuss your
specific requirements in detail email K4 CAD Solutions at:

                           admin@k4cadsolutions.co.uk

or visit the web site:     http://www.k4cadsolutions.co.uk


       Fixed price quotes offered for well defined and specified projects.
             K4 CAD Solutions is based in Yorkshire, United Kingdom.


WARRANTY STATEMENT
===============================================================================

Author is not responsible for any damages whatsoever, including loss of
information, interruption of business, personal injury and/or any damage or
consequential damage without limitation, incurred before, during or after the
use of this product. Author's entire liability, without exception, is limited to
the customers' reimbursement of the purchase price (if applicable) of the
software (maximum being the suggested retail price) in exchange for the
return of the product, all copies, registration papers and manuals, and all
materials that constitute a transfer of ownership from the customer back to
Author.


LICENSE
===============================================================================

Each registered copy of this software may be used in only one single
location by one user.  Use of the software means that you have loaded the
program and run it or have installed the program onto a computer.  If you
install the software onto a multi-user platform or network, each and every
individual user of the software must be registered separately.

You may make one copy of the registered software for backup purposes,
providing you only have one copy installed on one computer being used by
one person.  If any person other than yourself uses software registered in
your name, regardless of whether it is at the same time or different times,
then this agreement is being violated!

The sale of and or distribution of registered copies of this software are
strictly forbidden.  It is a violation of this agreement to loan, rent,
lease, borrow, or transfer the use of registered copies of this software
product.


            AutoCAD is a registered trademark of Autodesk Inc.
        Windows is a registered tradmark of Microsoft Corporation

===============================================================================
Copyright (C) K4 CAD Solutions, April 2002
===============================================================================
« Last Edit: October 09, 2006, 05:09:08 PM by Gary Fowler »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64

MickD

  • Gator
  • Posts: 3314
  • (x-in)->[process]->(y-out)
Re: Examples of usage GRREAD - let's share
« Reply #8 on: October 09, 2006, 06:52:09 PM »
...
Are you really sure about all this, or is it a lot of guesswork?
...

The part about how selection is accomplished yes, the accuracy of using irregular selection shapes no. Although it is possible to use irregular shapes it would take multiple passes or some mathematical gymnastics to get the correct primitives for the selection, especially if you had a curved edge in your selection shape.

I'll expand a bit on the selection process as performed by the grfx api for those interested. From here we'll call the host application using the grfx api the 'app' and the graphics api the 'grfx'.
Prior to selection, the app using the selection buffer must change the state of the grfx to 'selection' mode which draws all of the primitives to a special buffer (not to the screen) and gathers all of the objects drawn there.
Here's the process just using the std acad pickbox (cursor) which is about 4x4 pixels say -

1. The user picks a line say which sends a WM_MOUSEDOWN message, the app's window procedure catches and handles it appropriately. Depending on the state of the application it can handle this how it pleases, for now we'll say it is idle and will handle selection to highlight entities picked with the cursor in the editor (the client area of the main window where the grfx will draw its primitives).

2. Having caught the message the app has to tell the grfx it wants to do a sellection of the picked object. To do this the app must set the 'state' of the graphics to selection to draw to the selection buffer. To draw to this buffer (just like any other window) the app has to pass in of its viewing transformation, which also contains the view/model and clipping volume and finally maps this to a rectangle on the screen, generally the x and y size of our client rectangle/editor. In the case of the selection buffer we only want what's under the cursor so we pass in the x and y size of the 'pick box', the app assigns an id to each primitive (using named lists in the grfx) before it's drawn which the grfx uses to identify the drawn primitives. The grfx then draws the objects to the selection buffer, grabs a list of the ids it has drawn after 'clipping' and passes this list/array back to the app.
How does it get the id's? As the grfx has to calculate the colour of each pixel it draws to the buffer, in the selection mode it also assigns an id of each drawn primitive to each pixel within the selection rectangle/buffer, when you do a 'pick' or even a windowed selection you are just picking a rectangle/box of pixels and use the info store in the buffer mapped to that pixel.

3. On receiving the 'hit list' of objects drawn to the selection buffer (remembering the selection rect clips out all unwanted geometry outside of the rect passed in) the app iterates the list and handles it how it pleases, in Autocad's case it calls the ent->highlight() member function of the/each selected entity to tell it to draw itself highlighted. The app then redraws the scene in the normal rendering mode passing in all of the entities and now the ent's to be highlighted with the appropriate primitive line type to appear highlighted.

For autocad to use irregular selection with a polyline say, it would almost have to be only in 2d to keep the math simple and it would not need to use the selection buffer of the grfx, if it can do it with a 3d model (items that don't cross the polyline in the same plane) it would have to be doing its own projections to the polyline plane and then the clipping. Basically though the selction buffer is the most efficient way to collect selected entities IMO as this is what it is used and optimised for.

Cheers,
Mick.



« Last Edit: October 09, 2006, 06:54:25 PM by MickD »
Forth is like the Tao: it is a Way, and is realized when followed.
Its fragility is its strength; its simplicity is its direction - Michael Ham

Lao Tzu: “To attain knowledge, add things
every day; to obtain wisdom, remove things every day.”

sinc

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #9 on: October 09, 2006, 08:31:56 PM »

For autocad to use irregular selection with a polyline say, it would almost have to be only in 2d to keep the math simple and it would not need to use the selection buffer of the grfx, if it can do it with a 3d model (items that don't cross the polyline in the same plane) it would have to be doing its own projections to the polyline plane and then the clipping. Basically though the selction buffer is the most efficient way to collect selected entities IMO as this is what it is used and optimised for.


Autocad can in fact select anything, in full 3D, with irregular windows.  But I notice that irregular windows can also select things that are not visible on the screen, while the normal rectangular windows cannot.  So this seems to imply that Autocad uses the grfx for normal windows, but does its own model parsing for irregular windows.  I don't notice any performance difference between the two, but I'm guessing I might with a much bigger drawing or with slower hardware.

In either case, the objects appear to be projected in into the plane of the current view to determine what gets selected.

MickD

  • Gator
  • Posts: 3314
  • (x-in)->[process]->(y-out)
Re: Examples of usage GRREAD - let's share
« Reply #10 on: October 09, 2006, 09:08:15 PM »
...  I don't notice any performance difference between the two, but I'm guessing I might with a much bigger drawing or with slower hardware.

Not these days with the processing power we have, it may have been different back in 14/2000 though :)

Quote
In either case, the objects appear to be projected in into the plane of the current view to determine what gets selected.

I have been playing with my own 3d modeller in ogl for a while and an irregular selection will be a 'feature' that is not very high on the list because of the obvious complications but as you state above that is probably how I'd approach it - project the primitive linework to the viewing plane and clip.

sorry to polute the thread but this is one of my favorite subjects/api's...thanks for listening, carry on :)
Forth is like the Tao: it is a Way, and is realized when followed.
Its fragility is its strength; its simplicity is its direction - Michael Ham

Lao Tzu: “To attain knowledge, add things
every day; to obtain wisdom, remove things every day.”

SomeCallMeDave

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #11 on: October 10, 2006, 09:38:58 AM »
Here is one that I use to change the current elevation up or down by 2' just by gesturing up or down with the mouse.  I use it when I have to drawn contours manually.

Code: [Select]
(defun c:ew(/ NewEL el1 DeltaEl)
  (setq CurrElev (getvar "ELEVATION")
        newDir (dkb_readMouse)
  )
  (if (minusp newDir) (setq NewEl -2) (setq NewEl 2))       
 
  (setvar "ELEVATION" (+ CurrElev NewEL))
); end function ew


(defun dkb_readMouse()

    (setq firstY nil)     
   
    (while (= (setq grCode (car (setq grData (grread T 7 0)))) 5)
         (setq grReturn (cadr grData))
          (if (= grCode 5)
              (progn
                  (if (not firstY)
                       (setq firstY (cadr grReturn)
                             currDelta 0
                        )
                        (setq currDelta (- (cadr grReturn) firstY))
                   )     
               );progn then
          );if     
     );end while
)




And one to adjust the elevation by a small increment by continually moving the mouse up or down

Code: [Select]

(defun c:eew()
  (dkb_mouseelev)

)

(defun dkb_MouseElev()

    (setq firstY nil
          TotalY (getvar "VIEWSIZE")
          NumSteps 50
          YStep (fix (/ TotalY NumSteps))
          DeltaElPerStep 0.05
          CurrEL (getvar "ELEVATION")
    )     
    (while (= (setq grCode (car (setq grData (grread T 7 0)))) 5)
         (setq grReturn (cadr grData))
          (if (= grCode 5)
              (progn
                  (if (not firstY)
                       (setq firstY (cadr grReturn)
                             currDelta 0
                        )
                        (setvar "ELEVATION"
                          (+ CurrEl
                             (* DeltaElPerStep
                                 (fix (/(setq currDelta (- (cadr grReturn) firstY)) YStep))
                             )
                          )
                        );setvar and end else
                   ); end inner if     
               );progn then
          );if     
     );end while
)

And one to change the text value of a spot elevation by, you guessed it,  moving the mouse up or down.  The 'new text value' is shown in the modemacro box.  When the left mouse button is hit, the text string is changed to the modemacro value.

Code: [Select]
(defun c:et()
   (setq Ent1Name (car (entsel "\nPick Text to Edit "))
    Ent1List (entget Ent1Name)
    Ent1Elev (atof (cdr (assoc 1 Ent1List)))
    OldMode (getvar "MODEMACRO")
         OldElev (getvar "ELEVATION")
   );setq
   (setvar "MODEMACRO" (rtos Ent1Elev 2 2 ))
    (setq firstY nil
          TotalY (getvar "VIEWSIZE")
          NumSteps 50
          YStep (max (fix (/ TotalY NumSteps)) 1)
          DeltaElPerStep 0.05
          CurrEL (atof (getvar "MODEMACRO"))
    )     
    (while (= (setq grCode (car (setq grData (grread T 7 0)))) 5)
         (setq grReturn (cadr grData))
          (if (= grCode 5)
              (progn
                  (if (not firstY)
                       (setq firstY (cadr grReturn)
                             currDelta 0
                        )
                        (setvar "MODEMACRO"
                          (rtos (+ CurrEl
                             (* DeltaElPerStep
                                 (fix (/(setq currDelta (- (cadr grReturn) firstY)) YStep))
                             )
                          ) 2 2 )
                        );setvar and end else
                   ); end inner if     
               );progn then
          );if     
     );end while
     (setq newEl (atof (getvar "MODEMACRO"))
           newElStr (rtos newEl 2 2)
           newEntList (subst (cons 1 newElStr) (assoc 1 ent1List) ent1List)
     )
     (setvar "ELEVATION" oldElev)
     (setvar "MODEMACRO" oldMode)
     (entmod newEntList)
     (prin1)     
 
);defun et

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: Examples of usage GRREAD - let's share
« Reply #12 on: October 13, 2006, 11:18:01 AM »
It is a working example of usage of OSNAP and the shortcut menu together with GRREAD function.


Code: [Select]
(defun menu-pop500 (d / lst p s)
  ; Choice function of OSNAP through the shortcut menu.
  ; Only, as an example.
  ; Is checked up in AutoCad 2004-2007 (En)
  ; by ElpanovEvgeniy
  ; (2006-10-11)
  ; (menu-pop500 (grread t 5))
  (setq
    lst (reverse
          (menu-index
            ((lambda (x) (list (1- (vla-get-count x)) x))
              (vla-item
                (vla-get-menus
                  (vla-item
                    (vla-get-menugroups
                      (vlax-get-acad-object)
                    ) ;_  vla-get-MenuGroups
                    "ACAD"
                  ) ;_  vla-item
                ) ;_  vla-get-Menus
                "&Object Snap Cursor Menu"
                ;|
 " *Object Snap Cursor Menu "
For localization into other languages, it is possible to use function bu kpblc
(cond
  ((vl-string-search "419" (setq p(vlax-product-key)))
    ;; The Russian version
   "&Контекстное меню привязки")
  ((vl-string-search "409" p)
   ;; The English version
    "&Object Snap Cursor Menu"
    ))

|;
              ) ;_  vla-item
            )
          ) ;_  menu-index
        ) ;_  reverse
  ) ;_  setq
  (while (and
           (listp d)
           (or (= (car d) 5)
               (= (car d) 11)
               (= (car d) 12)
               (= (car d) 25) ; For old version AutoCad
           ) ;_  or
         ) ;_  and
    (cond
      ((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad
      ((equal d '(11 0)) (menucmd "POP500=*"))
      ((= (car d) 11) (setq s (nth (- (cadr d) 500) lst)))
    ) ;_  cond
    (if s
      (setq d s)
      (setq d (grread t 5))
    ) ;_  if
  ) ;_  while
  (substr s 1 4)
) ;_  defun
(defun menu-index (l)
  ; Creation of the list of choices of choice of OSNAP
  ; Is checked up in AutoCad 2004-2007 (En)
  ; by ElpanovEvgeniy
  ; (2006-10-11)
                  ;|
(menu-index
 ((lambda (x) (list (1-(vla-get-count x)) x))
  (vla-item
   (vla-get-menus
    (vla-item
     (vla-get-menugroups
      (vlax-get-acad-object)
      ) ;_  vla-get-MenuGroups
     "ACAD"
     ) ;_  vla-item
    ) ;_  vla-get-Menus
   "&Object Snap Cursor Menu"
   ) ;_  vla-item
  )
 ) ;_  menu-index
 |;
  (if (not (minusp (car l)))
    (cond
      ((= (vla-get-type (vla-item (cadr l) (car l))) 0)
       (cons
         (vla-get-macro (vla-item (cadr l) (car l)))
         (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_  cons
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 1)
       (menu-index (cons (1- (car l)) (cdr l)))
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 2)
       (append
         (menu-index
           ((lambda (x) (list (1- (vla-get-count x)) x))
             (vla-get-submenu (vla-item (cadr l) (car l)))
           ) ;_  menu-index
         ) ;_  menu-index
         (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_  append
      )
    ) ;_  cond
  ) ;_  if
) ;_  defun
(defun get_osmode nil
  ; Function create list osmode macro
  ; for result (getvar "OSMODE")
  ; by Evgeniy Elpanov
  ; (get_osmode)
  (mapcar
    (function cdr)
    (vl-remove-if
      (function
        (lambda (x)
          (zerop (logand (getvar "OSMODE") (car x)))
        ) ;_  lambda
      ) ;_  function
      '((1 . "_end")
        (2 . "_mid")
        (4 . "_cen")
        (8 . "_nod")
        (16 . "_qua")
        (32 . "_int")
        (64 . "_ins")
        (128 . "_per")
        (256 . "_tan")
        (512 . "_nea")
  ;(1024 . "_qui") ; Is not realized
        (2048 . "_app")
  ;(4096 . "_ext") ; Is not realized
  ;(8192 . "_par") ; Is not realized
       )
    ) ;_  substr
  ) ;_  mapcar
) ;_  defun


(defun osmode-grvecs-lst (/ -ASS ASS COL)
  ; Function create list
  ; for drawing icons osmode with the function grvecs
  ; by Evgeniy Elpanov
  ; (osmode-grvecs-lst)
  (setq
    col  (atoi (getenv "AutoSnapColor"))
    ass  (atof (getenv "AutoSnapSize"))
    -ass (- ass)
  ) ;_  setq
  (list
    (list
      "tracking"
      col
      (list (* -ass 0.2) 0.)
      (list (* ass 0.2) 0.)
      col
      (list 0. (* -ass 0.2))
      (list 0. (* ass 0.2))
    ) ;_  list
    (list
      "_end"
      col
      (list -ass -ass)
      (list -ass ass)
      col
      (list (1- -ass) (1- -ass))
      (list (1- -ass) (1+ ass))
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list ass ass)
      (list ass -ass)
      col
      (list (1+ ass) (1+ ass))
      (list (1+ ass) (1- -ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    (list
      "_mid"
      col
      (list -ass -ass)
      (list 0. ass)
      col
      (list (1- -ass) (1- -ass))
      (list 0. (1+ ass))
      col
      (list 0. ass)
      (list ass -ass)
      col
      (list 0. (1+ ass))
      (list (1+ ass) (1- -ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    (list
      "_cen"
      7
      (list (* -ass 0.2) 0.)
      (list (* ass 0.2) 0.)
      7
      (list 0. (* -ass 0.2))
      (list 0. (* ass 0.2))
      col
      (list -ass 0.)
      (list (* -ass 0.86) (* ass 0.5))
      col
      (list (* -ass 0.86) (* ass 0.5))
      (list (* -ass 0.5) (* ass 0.86))
      col
      (list (* -ass 0.5) (* ass 0.86))
      (list 0. ass)
      col
      (list 0. ass)
      (list (* ass 0.5) (* ass 0.86))
      col
      (list (* ass 0.5) (* ass 0.86))
      (list (* ass 0.86) (* ass 0.5))
      col
      (list (* ass 0.86) (* ass 0.5))
      (list ass 0.)
      col
      (list ass 0.)
      (list (* ass 0.86) (* -ass 0.5))
      col
      (list (* ass 0.86) (* -ass 0.5))
      (list (* ass 0.5) (* -ass 0.86))
      col
      (list (* ass 0.5) (* -ass 0.86))
      (list 0. -ass)
      col
      (list 0. -ass)
      (list (* -ass 0.5) (* -ass 0.86))
      col
      (list (* -ass 0.5) (* -ass 0.86))
      (list (* -ass 0.86) (* -ass 0.5))
      col
      (list (* -ass 0.86) (* -ass 0.5))
      (list -ass 0.)
    ) ;_  list
    (list
      "_nod"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list -ass ass)
      (list ass -ass)
      col
      (list -ass 0.)
      (list (* -ass 0.86) (* ass 0.5))
      col
      (list (* -ass 0.86) (* ass 0.5))
      (list (* -ass 0.5) (* ass 0.86))
      col
      (list (* -ass 0.5) (* ass 0.86))
      (list 0. ass)
      col
      (list 0. ass)
      (list (* ass 0.5) (* ass 0.86))
      col
      (list (* ass 0.5) (* ass 0.86))
      (list (* ass 0.86) (* ass 0.5))
      col
      (list (* ass 0.86) (* ass 0.5))
      (list ass 0.)
      col
      (list ass 0.)
      (list (* ass 0.86) (* -ass 0.5))
      col
      (list (* ass 0.86) (* -ass 0.5))
      (list (* ass 0.5) (* -ass 0.86))
      col
      (list (* ass 0.5) (* -ass 0.86))
      (list 0. -ass)
      col
      (list 0. -ass)
      (list (* -ass 0.5) (* -ass 0.86))
      col
      (list (* -ass 0.5) (* -ass 0.86))
      (list (* -ass 0.86) (* -ass 0.5))
      col
      (list (* -ass 0.86) (* -ass 0.5))
      (list -ass 0.)
    ) ;_  list
    (list
      "_qua"
      col
      (list 0. -ass)
      (list -ass 0.)
      col
      (list 0. (1- -ass))
      (list (1- -ass) 0.)
      col
      (list -ass 0.)
      (list 0. ass)
      col
      (list (1- -ass) 0.)
      (list 0. (1+ ass))
      col
      (list 0. ass)
      (list ass 0.)
      col
      (list 0. (1+ ass))
      (list (1+ ass) 0.)
      col
      (list ass 0.)
      (list 0. -ass)
      col
      (list (1+ ass) 0.)
      (list 0. (1- -ass))
    ) ;_  list
    (list
      "_int"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list -ass (1+ -ass))
      (list ass (1+ ass))
      col
      (list (1+ -ass) -ass)
      (list (1+ ass) ass)
      col
      (list -ass ass)
      (list ass -ass)
      col
      (list -ass (1+ ass))
      (list ass (1+ -ass))
      col
      (list (1+ -ass) ass)
      (list (1+ ass) -ass)
    ) ;_  list
    (list
      "_ins"
      col
      (list (* -ass 0.1) (* -ass 0.1))
      (list -ass (* -ass 0.1))
      col
      (list -ass (* -ass 0.1))
      (list -ass ass)
      col
      (list -ass ass)
      (list (* ass 0.1) ass)
      col
      (list (* ass 0.1) ass)
      (list (* ass 0.1) (* ass 0.1))
      col
      (list (* ass 0.1) (* ass 0.1))
      (list ass (* ass 0.1))
      col
      (list ass (* ass 0.1))
      (list ass -ass)
      col
      (list ass -ass)
      (list (* -ass 0.1) -ass)
      col
      (list (* -ass 0.1) -ass)
      (list (* -ass 0.1) (* -ass 0.1))
      col
      (list (1- (* -ass 0.1)) (1- (* -ass 0.1)))
      (list (1- -ass) (1- (* -ass 0.1)))
      col
      (list (1- -ass) (1- (* -ass 0.1)))
      (list (1- -ass) (1+ ass))
      col
      (list (1- -ass) (1+ ass))
      (list (1+ (* ass 0.1)) (1+ ass))
      col
      (list (1+ (* ass 0.1)) (1+ ass))
      (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
      col
      (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
      (list (1+ ass) (1+ (* ass 0.1)))
      col
      (list (1+ ass) (1+ (* ass 0.1)))
      (list (1+ ass) (1- -ass))
      col
      (list (1+ ass) (1- -ass))
      (list (1- (* -ass 0.1)) (1- -ass))
      col
      (list (1- (* -ass 0.1)) (1- -ass))
      (list (1- (* -ass 0.1)) (1- (* -ass 0.1)))
    ) ;_  list
    (list
      "_tan"
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list -ass 0.)
      (list (* -ass 0.86) (* ass 0.5))
      col
      (list (* -ass 0.86) (* ass 0.5))
      (list (* -ass 0.5) (* ass 0.86))
      col
      (list (* -ass 0.5) (* ass 0.86))
      (list 0. ass)
      col
      (list 0. ass)
      (list (* ass 0.5) (* ass 0.86))
      col
      (list (* ass 0.5) (* ass 0.86))
      (list (* ass 0.86) (* ass 0.5))
      col
      (list (* ass 0.86) (* ass 0.5))
      (list ass 0.)
      col
      (list ass 0.)
      (list (* ass 0.86) (* -ass 0.5))
      col
      (list (* ass 0.86) (* -ass 0.5))
      (list (* ass 0.5) (* -ass 0.86))
      col
      (list (* ass 0.5) (* -ass 0.86))
      (list 0. -ass)
      col
      (list 0. -ass)
      (list (* -ass 0.5) (* -ass 0.86))
      col
      (list (* -ass 0.5) (* -ass 0.86))
      (list (* -ass 0.86) (* -ass 0.5))
      col
      (list (* -ass 0.86) (* -ass 0.5))
      (list -ass 0.)
    ) ;_  list
    (list
      "_per"
      col
      (list -ass -ass)
      (list -ass ass)
      col
      (list (1- -ass) (1- -ass))
      (list (1- -ass) (1+ ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
      col
      (list -ass 0.)
      (list 0. 0.)
      col
      (list -ass -1.)
      (list 0. -1.)
      col
      (list 0. 0.)
      (list 0. -ass)
      col
      (list -1. 0.)
      (list -1. -ass)
    ) ;_  list
    (list
      "_nea"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list -ass ass)
      (list ass -ass)
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    (list
      "_app"
      col
      (list -ass -ass)
      (list ass ass)
      col
      (list ass -ass)
      (list -ass ass)

      col
      (list -ass -ass)
      (list -ass ass)
      col
      (list (1- -ass) (1- -ass))
      (list (1- -ass) (1+ ass))
      col
      (list -ass ass)
      (list ass ass)
      col
      (list (1- -ass) (1+ ass))
      (list (1+ ass) (1+ ass))
      col
      (list ass ass)
      (list ass -ass)
      col
      (list (1+ ass) (1+ ass))
      (list (1+ ass) (1- -ass))
      col
      (list ass -ass)
      (list -ass -ass)
      col
      (list (1+ ass) (1- -ass))
      (list (1- -ass) (1- -ass))
    ) ;_  list
    ;; Is not realized
    ;;    (list
    ;;    "_par"
    ;;      col
    ;;      (list (* -ass 0.8) -ass)
    ;;      (list ass (* ass 0.8))
    ;;      col
    ;;      (list -ass (* -ass 0.8))
    ;;      (list (* ass 0.8) ass)
    ;;    )

  ) ;_  list
) ;_  defun
(defun c:test (/ GR O OSM-LST OSMODE S TP)
  ; Example drawing icons osmode with
  ; Return point, for osmode
  ; by Evgeniy Elpanov
  ; (c:test)
  (setq osm-lst (osmode-grvecs-lst)
        osmode  (get_osmode)
  ) ;_  setq
  (while (or (= (car (setq gr (grread nil 5 0))) 5)
             (= (car gr) 11)
             (= (car gr) 25) ; For old version AutoCad
         ) ;_  or
    (if (or (= (car gr) 11)
            (= (car gr) 25)
        ) ;_  or
      (setq osmode (list (menu-pop500 gr)))
      (progn

        (if (setq
              o (vl-remove-if
                  (function null)
                  (mapcar
                    (function
                      (lambda (x / o)
                        (if (setq o (osnap (cadr gr) x))
                          (list (distance (cadr gr) o) o x (cadr gr))
                        ) ;_  if
                      ) ;_  lambda
                    ) ;_  function
                    osmode
                  ) ;_  mapcar
                ) ;_  vl-remove-if
            ) ;_  setq
          (setq
            o (cdar
                (vl-sort
                  o
                  (function
                    (lambda (a b)
                      (< (car a) (car b))
                    ) ;_  lambda
                  ) ;_  function
                ) ;_  vl-sort
              ) ;_  cdar
          ) ;_  setq
        ) ;_  if

        (setq s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE"))))
        (cond
          ((not o))
          ((WCMATCH (cadr o) "_end,_mid,_cen,_nod,_int,_ins")
           (setq tp (car o))
           (setvar "lastpoint" tp)
           (setq o (cons (trans (car o) 1 3) (cdr o)))
           (redraw)
           (grvecs
             (cdr (assoc "tracking" osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
           (grvecs
             (cdr (assoc (cadr o) osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
          )
          ((WCMATCH (cadr o) "_nea,_qua,_app")
           (setq o (cons (trans (car o) 1 3) (cdr o)))
           (redraw)
           (grvecs
             (cdr (assoc (cadr o) osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
          )
          ((and tp (not (equal tp (car o) 1e-8)))
           (redraw)
           (grdraw (car o) tp 7 1)
           (setq o (cons (trans (car o) 1 3) (cdr o)))
           (grvecs
             (cdr (assoc (cadr o) osm-lst))
             (list (list s 0. 0. (caar o))
                   (list 0. s 0. (cadar o))
                   (list 0. 0. s 0.)
                   '(0. 0. 0. 1.)
             ) ;_  list
           ) ;_  grvecs
          )
        ) ;_  cond
        (if tp
          (grvecs
            (cdr (assoc "tracking" osm-lst))
            (list (list s 0. 0. (car (trans tp 1 3)))
                  (list 0. s 0. (cadr (trans tp 1 3)))
                  (list 0. 0. s 0.)
                  '(0. 0. 0. 1.)
            ) ;_  list
          ) ;_  grvecs
        ) ;_  if
      ) ;_  progn
    ) ;_  if
  ) ;_  while
  (redraw)
  (if o
    (osnap (caddr o) (cadr o))
    (cadr gr)
  ) ;_  if
) ;_  defun

This example not finished, I ask to give advices and remarks!  :-)

蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

MP

  • Seagull
  • Posts: 17493
Re: Examples of usage GRREAD - let's share
« Reply #13 on: October 13, 2006, 12:01:34 PM »
Wow, what's with all the George Bush references in osmode-grvecs-lst?

:-D

Kidding aside, I'll try to have a look this weekend, looks to be good stuff from the 30000 ft flyover Evgeniy!

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10369
Re: Examples of usage GRREAD - let's share
« Reply #14 on: October 13, 2006, 01:29:31 PM »
Tested in ACAD2004, very nice. :-)
Keep up the good work.
Will try to look at the code this weekend.

Thanks
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.