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

0 Members and 2 Guests are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12411
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #105 on: March 09, 2011, 08:38:37 AM »
For OSnap etc, you might like to look at acet-ss-drag-move, although this is outside the intention of this 'grread' oriented thread.

alanjt

  • Needs a day job
  • Posts: 5339
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #106 on: March 09, 2011, 08:53:20 AM »
For OSnap etc, you might like to look at acet-ss-drag-move, although this is outside the intention of this 'grread' oriented thread.
Still a useful sub.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Lee Mac

  • Seagull
  • Posts: 12411
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #107 on: March 09, 2011, 08:57:25 AM »
BTW was my last explanation clearer for you?

alanjt

  • Needs a day job
  • Posts: 5339
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #108 on: March 09, 2011, 08:59:07 AM »
BTW was my last explanation clearer for you?
I didn't even see that one, have to give it a read.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Lee Mac

  • Seagull
  • Posts: 12411
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #109 on: March 09, 2011, 09:57:21 AM »
One more:

Code: [Select]
(defun ucsline ( p a / g )
  (while (= 5 (car (setq g (grread t 13 0)))) (redraw) (setq g (cadr g))
    (grdraw p
      (apply 'polar
        (cons p
          (
            (lambda ( n / x z )
              (setq x (- (car   (trans g 1 n)) (car   (trans p 1 n)))
                    z (- (caddr (trans g 1 n)) (caddr (trans p 1 n)))
              )
              (if (< (abs z) (abs x)) (list (+ a (/ pi 2.)) x) (list a z))
            )
            (polar '(0. 0. 0.) a 1.0)
          )
        )
      )
      -1
    )
  )
  (redraw) (if (listp (cadr g)) (cadr g))
)

Code: [Select]
(ucsline (getpoint "\nBase Point: ") (/ pi 6.))

alanjt

  • Needs a day job
  • Posts: 5339
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #110 on: March 09, 2011, 10:06:53 AM »
You should change this line so the point is only return if the user left-clicks - matches actual functionality of AutoCAD.

Code: [Select]
(if (and (listp (cadr g)) (eq 3 (car g))) (cadr g))
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Lee Mac

  • Seagull
  • Posts: 12411
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #111 on: March 09, 2011, 10:15:46 AM »
You should change this line so the point is only return if the user left-clicks - matches actual functionality of AutoCAD.

Code: [Select]
(if (and (listp (cadr g)) (eq 3 (car g))) (cadr g))

Does it not already have that behaviour?

Lee Mac

  • Seagull
  • Posts: 12411
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #112 on: March 09, 2011, 10:16:53 AM »
Another more realistic example:

Code: [Select]
(defun c:test ( / p g a ) (setq a (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 1 t)))
 
  (if (setq p (getpoint "\nSpecify First Point: "))
    (while (or (= 5 (car (setq g (grread t 15 0)))) (= 2 (car g))) (redraw) (setq g (cadr g))
      (if (listp g)
        (grdraw p
          (if (zerop (getvar 'ORTHOMODE)) g
            (apply 'polar
              (cons p
                (
                  (lambda ( n / x z )
                    (setq x (- (car   (trans g 1 n)) (car   (trans p 1 n)))
                          z (- (caddr (trans g 1 n)) (caddr (trans p 1 n)))
                    )
                    (if (< (abs z) (abs x)) (list (+ a (/ pi 2.)) x) (list a z))
                  )
                  (polar '(0. 0. 0.) a 1.0)
                )
              )
            )
          )
          -1
        )
        (if (= 15 g) (setvar 'ORTHOMODE (- 1 (getvar 'ORTHOMODE))))
      )     
    )
  )
  (redraw) (if (listp (cadr g)) (cadr g))
)

alanjt

  • Needs a day job
  • Posts: 5339
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #113 on: March 09, 2011, 10:18:04 AM »
You should change this line so the point is only return if the user left-clicks - matches actual functionality of AutoCAD.

Code: [Select]
(if (and (listp (cadr g)) (eq 3 (car g))) (cadr g))

Does it not already have that behaviour?
Nevermind, I'm retarded. :ugly:
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Lee Mac

  • Seagull
  • Posts: 12411
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #114 on: March 10, 2011, 08:05:49 PM »

chlh_jd

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #115 on: March 11, 2011, 11:48:43 AM »
hi all
here's draw a leader , it's so simple
Code: [Select]
;;;to draw a leader and change the direction  with mouse move
;;;by GSLS(SS)
(defun c:ss_JT (/ pt1 pt2 pt3 pt is_back0 is_go_on en en1)
  (svos) 
  (setvar 'cmdecho 0)
  (setvar 'PICKSTYLE 0)
  (setq pt1 (getpoint))
  (setq pt2 (getpoint pt1))
  (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2)))
  (setq en1 (entlast))
  (redraw en1 3)
  (setq pt3 (getpoint pt2))
  (draw-pline
    (list pt1 pt2 (polar pt3 (angle pt3 pt2) 450) pt3) ;_here you can change the Neck Point Distance '450'
    '((0.0 0.0) (0.0 0.0) (150.0 0.0) (0.0 0.0)); here you can change the Neck Width '150.0'
    nil
    nil
    -1
    0
  )
  (setq en (entlast))
  (redraw en 3)
  (entdel en1)
  (setq pt (grread t 4 2))
  (setq is_back0
(if (< (distance (cadr pt) pt3) (distance (cadr pt) pt1))
   1
   -1
)
is_go_on T
  )
  (while (and (/= 3 (car PT))
      (/= 25 (car pt))
      is_go_on
)
    (cond
      ((and (= 2 (car pt)) (or (= 13 (cadr pt)) (= 32 (cadr pt)))) ;_Space or Enter
       (setq is_go_on nil)
       (setq is_back
      (if
(< (distance (cadr pt) pt3) (distance (cadr pt) pt1))
1
-1
      )
       )
       (if (< (* is_back0 is_back) 0)
(progn (entdel en)
(if (= is_back 1)
  (draw-pline
    (list pt1 pt2 (polar pt3 (angle pt3 pt2) 450) pt3)
    '((0.0 0.0) (0.0 0.0) (150.0 0.0) (0.0 0.0))
    nil
    nil
    -1
    0
  )
  (draw-pline
    (list pt1 (polar pt1 (angle pt1 pt2) 450) pt2 pt3)
    '((0.0 150.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))
    nil
    nil
    -1
    0
  )
)
   (setq en (entlast))
           (redraw en 4)
)
       )       
      )
      (t
       (setq is_back
      (if
(< (distance (cadr pt) pt3) (distance (cadr pt) pt1))
1
-1
      )
       )
       (if (< (* is_back0 is_back) 0)
(progn (entdel en)
(if (= is_back 1)
  (draw-pline
    (list pt1 pt2 (polar pt3 (angle pt3 pt2) 450) pt3)
    '((0.0 0.0) (0.0 0.0) (150.0 0.0) (0.0 0.0))
    nil
    nil
    -1
    0
  )
  (draw-pline
    (list pt1 (polar pt1 (angle pt1 pt2) 450) pt2 pt3)
    '((0.0 150.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))
    nil
    nil
    -1
    0
  )
)
(setq en (entlast))
(redraw en 3)
)
       )
       (setq is_back0 is_back)
      )
    ) ;_cond
    (setq PT (grread t 4 2))
  )
  (redraw en 4) 
  (clos)
  (princ)
)
;;;Error-handing
  (defun ss-errexit (msg)
    (command)
    (command)
    (if (or (= msg "Function cancelled")
    (= msg "quit / exit abort")
)
      (princ msg)
      (princ (strcat "\n错误: " msg))
    )
    (clos)
  ) 
;;;save old sysvar
(defun svos ()
  (setq #system#    '("OSMODE"      "ORTHOMODE"    "CLAYER"
      "CECOLOR"      "PLINEWID"     "CELTYPE"
      "CMDECHO"      "ELEVATION"    "PICKSTYLE"
     )
#vlale#     (mapcar 'getvar #system#)
gsls_olderr *error*
*error*     ss-errexit
  )
  (vla-startundomark
    (vla-get-activedocument (vlax-get-acad-object))
  )
)
;;;---------------------------------------------------------------------;;;
;;;call old sysvar
(defun clos ()
  (vla-EndUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  )
  (MapCar 'setvar #system# #vlale#)
  (setq *error* gsls_olderr)
)
;;;--------------------------------------------------------------------------------------;;;
;;;drwa-pline                                                                            ;;;
;;;--------------------------------------------------------------------------------------;;;
;;;
;;;function: to make a polyline by code and return ename
;;;
;;;Variants:
;;;pl_list: the points list offered by order
;;;width : 0.0 or num, or a list like ((0.0 0.0) (0.0 20) (20 0.0)...),if nil it will getvar "plinewid" ,
;;;        if it's length noteq d90 then wid41 and wid42 equal to 0.0 .   
;;;d42_lst: 0.0 or num, or nil, if nil or it's length noteq d90 then d42 equal to 0.0 .
;;;
;;;lay_pl: layername, if nil it will getvar "CLAYER"
;;;
;;;color : color number, if it's -1 then getvar "COLOR" ellse set it by the given color number
;;;
;;;Prompt:
;;;If width list or d42_lst list is Exist , it's order must be same to the pl_list,
;;;   otherwise it will take out a wrong polyline .
;;;
;;;Written By GSLS(SS),2010.06.30
;;;
(defun draw-pline
  (pl_list width   d42_lst lay_pl  color   d70
   /    d90    i    wid    d42    wid40
   wid41   en000   pb
  )
  (setq d90 (length pl_list)
pb  '()
i   0
  )
  (cond ((and (listp width)
      (listp d42_lst)
      (= (length width) (length d42_lst) d90)
)
(foreach pt pl_list
   (setq wid   (nth i width)
d42   (nth i d42_lst)
wid40 (car wid)
wid41 (cadr wid)
pb    (append pb
       (list (cons 10 pt)
     (cons 40 wid40)
     (cons 41 wid41)
     (cons 42 d42)
       )
       )
i     (1+ i)
   )
)
)
((and (or (numberp width) (null width))
      (listp d42_lst)
      (= (length d42_lst) d90)
)
(if (null width)
   (setq wid40 (getvar "plinewid")
wid41 (getvar "plinewid")
   )
   (setq wid40 width
wid41 width
   )
)
(foreach pt pl_list
   (setq d42 (nth i d42_lst)
pb  (append pb
     (list (cons 10 pt)
   (cons 40 wid40)
   (cons 41 wid41)
   (cons 42 d42)
     )
     )
i   (1+ i)
   )
)
)
((and (listp width)
      (= (length width) d90)
      (or (null d42_lst) (numberp d42_lst))
)
(if (null d42_lst)
   (setq d42 0.0)
   (setq d42 d42_lst)
)
(foreach pt pl_list
   (setq wid   (nth i width)
wid40 (car wid)
wid41 (cadr wid)
pb    (append pb
       (list (cons 10 pt)
     (cons 40 wid40)
     (cons 41 wid41)
     (cons 42 d42)
       )
       )
i     (1+ i)
   )
)
)
(t
(if (numberp width)
   (setq wid40 width
wid41 width
   )
   (setq wid40 0.0
wid41 0.0
   )
)
(foreach pt pl_list
   (setq pb (append pb
    (list (cons 10 pt)
  (cons 40 wid40)
  (cons 41 wid41)
  (cons 42 0.0)
    )
    )
   )
)
)
  )
  (setq en000 (append (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8
      (if (and lay_pl (/= lay_pl ""))
lay_pl
(getvar "CLAYER")
      )
)
(cons 100 "AcDbPolyline")
(cons 90 d90)
(cons 70 d70)
      )
      pb
      )
  )
  (if (and color (/= -1 color))
    (setq en000 (append en000 (list (cons 62 color))))
  )
  (if (= nil (entmake en000))
    (princ "\nerror:entity-list error.")
  )
  (entlast)
)

xiaxiang

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #116 on: March 12, 2011, 05:08:27 AM »
hi all
here's draw a leader , it's so simple
Nice work,chlh_jd !

alanjt

  • Needs a day job
  • Posts: 5339
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #117 on: March 13, 2011, 01:54:57 PM »
I use this very simple routine to draw an arrow:
Code: [Select]
(defun c:Arrow (/ a b)
  ;; Draw quick arrow
  ;; Alan J. Thompson
  (if (and (setq a (getpoint "\nSpecify first point: "))
           (setq b (getpoint a "\nSpecity next point: "))
      )
    (command "_.leader" "_non" a "_non" b "" "" "_N")
  )
  (princ)
)
but chlh_jd and boredom inspired me to write these...

Code: [Select]
(defun c:Arrow (/ _group _dist lastentity p1 p2 ent obj gr coords pt)
  ;; Draw quick arrow
  ;; Alan J. Thompson, 03.13.11
  (defun _group (l)
    (if (caddr l)
      (cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
    )
  )

  (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

  (setq lastentity (entlast))
  (if (and (setq p1 (getpoint "\nSpecify first point: "))
           (setq p2 (getpoint p1 "\nSpecity next point: "))
           (vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
           (not (equal lastentity (setq ent (entlast))))
           (setq obj (vlax-ename->vla-object ent))
      )
    (while (eq 5 (car (setq gr (grread T 15 0))))
      (redraw)
      (grdraw (cadr gr)
              (trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
              3
              -1
      )
      (if
        (equal
          (last (setq coords (_group (vlax-get obj 'Coordinates))))
          (car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
        )
         (vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
      )
      (grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
    )
  )
  (redraw)
  (princ)
)



and this one for multiple segments (got a little carried away)...
Code: [Select]
(defun c:ArrowM
       (/ _group _getPoints _arrow _closestpt AT:Arrow lastentity AT:Midpoint lst ent obj gr coords)
  ;; Draw Arrow
  ;; Alan J. Thompson, 03.13.11

  (defun _group (l)
    (if (caddr l)
      (cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
    )
  )

  (defun _getPoints (/ lst pt)
    (if (car (setq lst (list (getpoint "\nSpecify first point: "))))
      ((lambda (color)
         (while (setq pt (getpoint (car lst) "\nSpecify next point: "))
           (redraw)
           (mapcar (function (lambda (a b) (and a b (grdraw a b color -1))))
                   (setq lst (cons pt lst))
                   (cdr lst)
           )
           (AT:Arrow (car lst) (angle (cadr lst) (car lst)))
         )
         (redraw)
         lst
       )
        (cdr (assoc 62 (tblsearch "LAYER" (getvar 'CLAYER))))
      )
    )
  )

  (defun _arrow (lst)
    (mapcar
      (function
        (lambda (a b)
          (and a b (AT:Arrow (trans (AT:MidPoint a b) 0 1) (angle (trans b 0 1) (trans a 0 1))))
        )
      )
      lst
      (cdr lst)
    )
  )

  (defun _closestpt (lst p)
    (car (vl-sort lst (function (lambda (a b) (< (distance a p) (distance b p))))))
  )

  (defun AT:Arrow (#Location #Angle / #Size #Point1 #Point2 #Point3)
    ;; Display directional arrow
    ;; #Location - arrow placement point
    ;; #Angle - arrow directional angle
    ;; Alan J. Thompson, 04.28.09
    (setq #Size   (* (getvar "viewsize") 0.02)
          #Point1 (polar #Location #Angle #Size)
          #Point2 (polar #Location (+ #Angle (* pi 0.85)) #Size)
          #Point3 (polar #Location (+ #Angle (* pi 1.15)) #Size)
    )
    (grvecs (list 4 #Point1 #Point2 #Point2 #Point3 #Point3 #Point1))
    #Location
  )


  (defun AT:Midpoint (p1 p2)
    ;; Midpoint between two points
    ;; Alan J. Thompson, 04.23.09
    (mapcar (function (lambda (a b) (/ (+ a b) 2.))) p1 p2)
  )

  (setq lastentity (entlast))
  (if (and (setq lst (_getPoints))
           (progn (vl-cmdf "_.leader") (foreach p lst (vl-cmdf "_non" p)) (vl-cmdf "" "" "_N"))
           (not (equal lastentity (setq ent (entlast))))
           (setq obj (vlax-ename->vla-object ent))
      )
    (while (eq 5 (car (setq gr (grread T 15 0))))
      (redraw)
      (grdraw (cadr gr) (trans (vlax-curve-getClosestPointTo ent (trans (cadr gr) 1 0)) 0 1) 3 -1)
      (grdraw (cadr gr) (trans (car (setq coords (_group (vlax-get obj 'Coordinates)))) 0 1) 1 -1)
      (_arrow coords)
      (if (equal (last coords) (_closestpt coords (trans (cadr gr) 1 0)))
        (vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
      )
    )
  )
  (redraw)
  (princ)
)

Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5339
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #118 on: March 13, 2011, 01:56:36 PM »
Oh yeah, and one for LWPolyline widths...

Code: [Select]
(defun c:PW (/ _width _colorUp _dist AT:SS->List sslst gr p&c wd)
  ;; set LWPolyline Width
  ;; Alan J. Thompson, 03.12.11

  (vl-load-com)

  (defun _width (d w) (entupd (cdr (assoc -1 (entmod (subst (cons 43 w) (assoc 43 d) d))))))

  (defun _colorUp (n)
    (if (> (setq n (+ n 100)) 249)
      1
      n
    )
  )

  (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

  (defun AT:SS->List (ss vla / i l)
    ;; Convert selection set to list of ename or vla objects
    ;; ss - SSGET selection set
    ;; vla - T for vla objects, nil for ename
    ;; Alan J. Thompson, 04.01.10
    (if (eq (type ss) 'PICKSET)
      (if vla
        (repeat (setq i (sslength ss))
          (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
        (repeat (setq i (sslength ss)) (setq l (cons (ssname ss (setq i (1- i))) l)))
      )
    )
  )

  (if (setq sslst (AT:SS->List (ssget "_:L" '((0 . "LWPOLYLINE"))) nil))
    (progn (while (eq 5 (car (setq gr (grread T 15 0))))
             (redraw)
             (grdraw
               (cadr gr)
               (car (setq p&c
                           (car
                             (vl-sort
                               (mapcar
                                 (function
                                   (lambda (e / d)
                                     (cons (trans (vlax-curve-getClosestPointTo e (trans (cadr gr) 1 0)) 0 1)
                                           (_colorUp (cond ((cdr (assoc 62 (setq d (entget e)))))
                                                           ((cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 d))))))
                                                     )
                                           )
                                     )
                                   )
                                 )
                                 sslst
                               )
                               (function (lambda (a b) (< (_dist (car a) (cadr gr)) (_dist (car b) (cadr gr)))))
                             )
                           )
                    )
               )
               (cdr p&c)
               -1
             )
             (princ (strcat "\rLWPolyline width: "
                            (rtos (setq wd (* (_dist (cadr gr) (car p&c)) 2.)))
                            "          "
                    )
             )
             (foreach e sslst (_width (entget e) wd))
           )
    )
  )
  (redraw)
  (princ)
)

Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

chlh_jd

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #119 on: March 14, 2011, 01:22:46 AM »
Excellent , Alan ! :-)
You have used the better method grdraw to show middle routine . I can learn a lot from your code