Topic: osnaps for grread

[CAB]

This is my solution to the lack of Osnaps with grread.
I use the osnap function and the current osmode settings to get the
point picked. The short fall is the lack of visual feed back of the actual
snap being used. The grid does snap into the position which will be it's
final destination but the actual snap mode that is being used is not displayed.
I though about using stepping through each osmode being used with getpoint
and comparing that with the point returned by

Code: [Select]

(setq ghostpt (osnap (cadr drag) (get_osmode)))Finding a match, then a symbol could be displayed at the location via grvecs.
Just an idea I was playing with.

The original grid lisp idea, I think, came from this thread:
http://www.theswamp.org/index.php?topic=4149.0
Thanks, Chuck

Here is the discussion by GaryF, where Gary's version of a grid  routine came to me.
http://discussion.autodesk.com/thread.jspa?forumID=130&threadID=389010

The Grid example is just a way to experiment with the Osnaps which I am interested in.

Code: [Select]

;;  eGrid.lsp 
;;  Rewritten by CAB @ TheSwamp.org
;; 
;;  User picks a rectangle to size the 24x24 grid lines the
;;  User drags the grid to it's final position

(defun c:egrid (/       DRAG    GHOSTPT H_CNT   H_CNT   H_DIST  H_OFS   PLIST
                PT_1    PT_2    TIME    TMP     V_CNT   V_CNT   V_DIST  V_OFS
                get_osmode calc_ get_points DrawGrid ghost
               )

 
  ;;  CAB  10/5/2006
  ;;
  ;;  Function to return the current osmode setting in the form of a string
  ;;  If (getvar "osmode") = 175
  ;;  (get_osmode)  returns   "_end,_mid,_cen,_nod,_int,_per"
  (defun get_osmode (/ cur_mode mode$)
    (setq mode$ "")
    (if (< 0 (setq cur_mode (getvar "osmode")) 16383)
      (mapcar
        '(lambda (x)
           (if (not (zerop (logand cur_mode (car x))))
             (setq mode$ (strcat mode$ (cadr x)))
           )
         )
        '(
          (0    "_non,")
          (1    "_end,")
          (2    "_mid,")
          (4    "_cen,")
          (8    "_nod,")
          (16   "_qua,")
          (32   "_int,")
          (64   "_ins,")
          (128  "_per,")
          (256  "_tan,")
          (512  "_nea,")
          (1024 "_qui,")
          (2048 "_app,")
          (4096 "_ext,")
          (8192 "_par")
         )
      )
    )
    mode$
  )

  ;;  Subrutine - calc offset & count
  (defun calc_ (dist / rm ofs count)
    (setq count (/ dist 24.0))
    (setq rm (- count (fix count)))
    (setq ofs (* rm 12))

    (cond
      ((zerop rm)                       ; 24 even
       (setq count (1- count)
             ofs   24
       )
      )
      ((< ofs 12)
       (setq ofs   (+ ofs 12)
             count (1- count)
       )
      )
    )
    (list ofs (fix count))
  )


  (defun get_points (ll h_ofs h_cnt v_ofs v_cnt h_dist v_dist / up ptl pts pte)
    (setq up (/ pi 2))
    ;;  hor lines
    (setq pts (polar ll up v_ofs)
          pte (polar pts 0 h_dist)
    )
    (setq ptl (list (list pts pte)))
    (repeat v_cnt
      (setq pts (polar pts up 24)
            pte (polar pts 0 h_dist)
      )
      (setq ptl (cons (list pts pte) ptl))
    )
    ;;  vert lines
    (setq pts (polar ll 0 h_ofs)
          pte (polar pts up v_dist)
    )
    (setq ptl (cons (list pts pte) ptl))
    (repeat h_cnt
      (setq pts (polar pts 0 24)
            pte (polar pts up v_dist)
      )
      (setq ptl (cons (list pts pte) ptl))
    )
    ptl
  )


  ;;  Draw the Grid
  (defun DrawGrid (plist / mk_line)
    (defun mk_line (st en)
      (entmake (list
                 (cons 0 "LINE")        ;***
                 (cons 6 "BYLAYER")
                 (cons 8 "0")
                 (cons 10 st)           ;***
                 (cons 11 en)           ;***
                 (cons 39 0.0)
                 (cons 62 256)
                 (cons 210 (list 0.0 0.0 1.0))
               )
      )
    )
    (mapcar '(lambda (x) (mk_line (car x) (cadr x))) plist)

  )


  ;;  Ghost the Grid
  (defun ghost (plist / pv)
    (mapcar '(lambda (x)
               (if pv
                 (setq pv (cons (car x) (cons (cadr x) (cons 4 pv))))
                 (setq pv (list (car x) (cadr x) 4))
               )
             )
            plist
    )
    (grvecs (reverse pv))
  )


  ;;****************************
  ;;  Main Routine starts here 
  ;;****************************
  (setq pt_1 (getpoint "\n* Size the Grid, Pick Lower-Left corner *"))
  (setq pt_2 (getcorner pt_1 "\n* Pick Upper-Right corner *"))

  (setq h_dist (- (car pt_2) (car pt_1))) ; horizontal length of the rectangle
  (setq v_dist (- (cadr pt_2) (cadr pt_1))) ; vertical length of the rectangle


  (setq tmp   (Calc_ h_dist)
        h_ofs (car tmp)
        h_cnt (cadr tmp)
  )

  (setq tmp   (Calc_ v_dist)
        v_ofs (car tmp)
        v_cnt (cadr tmp)
  )


  (setq time T)
  (while time
    (setq drag (grread t 1 1))
    (cond
      ((= (car drag) 5)
       (if (null (setq ghostpt (osnap (cadr drag) (get_osmode))))
         (setq ghostpt (cadr drag))
       )
       (redraw)
       (setq plist (get_points ghostpt h_ofs h_cnt v_ofs v_cnt h_dist v_dist))
       (ghost plist)
      )
      ((= (car drag) 3)
       ;;(setq ghostpt (cadr drag))
       (if (null (setq ghostpt (osnap (cadr drag) (get_osmode))))
         (setq ghostpt (cadr drag))
       )
       (redraw)
       (setq plist (get_points ghostpt h_ofs h_cnt v_ofs v_cnt h_dist v_dist))
       (DrawGrid plist)
       (setq time nil)
      )
    )
  )
  (princ)
)

[GDF]

Alan

Thanks, I had forgotton about that routine. It is not mine (by nivuahc). I was trying to understand how it worked. Played
with it and then forgot about it. I was pasting other code into, I think (my memory fails me here, no it must have been another similar routine).

Gary

[sepperl]

Hi CAB !

Interesting Code !

The following Code might help you to display the type of osnap by grvecs.

Sorry for the short answer, but I'm too tired for more explanations....

Code: [Select]

(defun c:test (/ grpnt seglist size width)
  (setq seglist '(((-1 1) (1 1))
                  ((1 1) (1 -1))
                  ((1 -1) (-1 -1))
                  ((-1 -1) (-1 1)) ;square
                  ((-4.0 -1.0) (-2.0 1.0))
                  ((-4.0 1.0) (-2.0 -1.0)) ; X
                 )
  )
  (setq size  (getint>0 "Size in Pixel" 10)
        width (getint>0 "Line width in Pixel" 4)
  )
  (while (= 5 (car (setq grpnt (grread t 1 1))))
    (redraw)
    (gr:boldvecs seglist
                 2
                 width
                 (gr:getmatrix (cadr grpnt) (* size (gr:getpixelsize)))
    )
  )
  (redraw)
)
;;;--------------------------------
;;; Draw seglist with grvecs
;;; Arg: seglist - ((from-pt to-pt) (from to).....) not equal with grvecs !!!
;;; color
;;; width - line width in Pixel
;;; matrix - 4x4 Matrix (Transformation)
;;; Ret: undef.
;;;--------------------------------
(defun gr:boldvecs (seglist color width matrix /)
  (grvecs
    ;; add color
    (cons color
          ;; seglist -> vectorlist
          (apply 'append
                 ;; Get parallel lines for each segment (bold lines)
                 (mapcar (function (lambda (2pt /)
                                     (gr:get//lines ;; point x matrix
                                                    (mtx:ptxmatrix (car 2pt) matrix)
                                                    (mtx:ptxmatrix (cadr 2pt) matrix)
                                                    width
                                     )
                                   )
                         )
                         seglist
                 )
          )
    )
  )
)
;;;--------------------------------
;;; Calculate parallel lines for bold line
;;; Arg: from - line startpoint
;;; to - line endpoint
;;; width - line width in Pixel
;;; Ret: pointlist (vectors) like grvecs (from to from to .....)
;;;--------------------------------
(defun gr:get//lines (from to width / angl angr n ptlist pixsize)
  (setq pixsize (gr:getpixelsize)
        angl    (+ (angle from to) (* 0.5 pi))
        angr    (- (angle from to) (* 0.5 pi))
        ptlist  (list from to)
        n       1
  )
  (repeat (fix (/ width 2))
    (setq ptlist (cons (polar from angr (* n pixsize))
                       (cons (polar to angr (* n pixsize))
                             (cons (polar from angl (* n pixsize))
                                   (cons (polar to angl (* n pixsize)) ptlist)
                             )
                       )
                 )
    )
    (setq n (1+ n))
  )
  ;; return
  ptlist
)
;;;-----------------------------
;;; Get size of 1 Pixel in dwg-units
;;;-----------------------------
(defun gr:getpixelsize (/) (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
;;;--------------------------------
;;; Get Transformationmatrix
;;; Scale at 0,0 + move
;;; Arg: translation - vektor
;;; scale - scalefactor
;;; Ret: 4x4 matrix
;;;--------------------------------
(defun gr:getmatrix (translation scale /)
  (list (list scale 0.0 0.0 (car translation))
        (list 0.0 scale 0.0 (cadr translation))
        (list 0.0 0.0 scale (caddr translation))
        (list 0.0 0.0 0.0 1.0)
  )
)
;;;------------------------------
;;;  point X 4x4 Matix (Transform)
;;;------------------------------
(defun mtx:ptxmatrix (pt matrix)
  (if (= (length pt) 2)
    (setq pt (append pt '(0.0 1.0)))
    (setq pt (append pt '(1.0)))
  )
  (mapcar (function (lambda (item) (apply '+ item)))
          (list (mapcar '* pt (car matrix))
                (mapcar '* pt (cadr matrix))
                (mapcar '* pt (caddr matrix))
          )
  )
)
;;;--------------------------------
(defun getint>0 (msg default)
  (initget (+ 2 4))
  (fix (cond ((getreal (strcat "\n" msg " <" (itoa (fix default)) ">: ")))
             (t default)
       )
  )
)

[CAB]

Thanks for your contribution.
Welcome to the Swamp.

I'll look you code over this week end.

[daron]

Hey Alan, I didn't know you were Gator Alumni

Rewritten by CAB @ TheSwamp.com

Didn't you mean TheSwamp.ORG?

[CAB]

Thanks for the sharp eye Daron. Changed it.
Yea, I was here back in the days, think it was the BigSwamp in those days
That is if I remember correctly, wow I think I'm getting as old as Ted.

[ElpanovEvgeniy]

Choice function of OSNAP through the shortcut menu.
Only, as an example.

Code: [Select]

(defun c:test (/ d)
  (princ "\nPress the right mouse button")
  (while (or (= (car (setq d (grread t 32))) 5)
             (= (car d) 25)
             (= (car d) 11)
         ) ;_  or
    (cond
      ((= (car d) 25) (menucmd "POP0=*"))
      ((= (car d) 11)
       (alert (vla-get-Macro
                (vla-item
                  (vla-item
                    (vla-get-Menus
                      (vla-item
                        (vla-get-MenuGroups
                          (vlax-get-acad-object)
                        ) ;_  vla-get-MenuGroups
                        "ACAD"
                      ) ;_  vla-item
                    ) ;_  vla-get-Menus
                    0
                  ) ;_  vla-item
                  (cond
                    ((< (cadr d) 502) (- (cadr d) 500))
                    ((< 501 (cadr d)508) "")
                    ((< (cadr d) 513) (- (cadr d) 504))
                    ((< (cadr d) 516) (- (cadr d) 503))
                    ((< (cadr d) 522) (- (cadr d) 502))
                    (t "")
                  ) ;_  cond
                ) ;_  vla-item
              ) ;_  vla-get-Macro
       ) ;_  alert
      )
    ) ;_  cond
  ) ;_  while
) ;_  defun


[ElpanovEvgeniy]

Has checked up, works in 2004 and does not work in 2007...

[ElpanovEvgeniy]

Code: [Select]

(defun c:test (/ d lst)
  ; 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)
  ; (c:test)
  (princ "\nPress the right mouse button")
  (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"
                  ) ;_  vla-item
                )
              ) ;_  menu-index
            ) ;_  reverse
  ) ;_  setq
  (while (or (= (car (setq d (grread t 5))) 5)
             (= (car d) 11)
             (= (car d) 12)
             (= (car d) 25) ; For old version AutoCad
         ) ;_  or
    (cond
      ((= (car d) 25) (menucmd "POP0=*")) ; For old version AutoCad
      ((equal d '(11 0)) (menucmd "POP0=*"))
      ((= (car d) 11) (alert (nth (- (cadr d) 500) lst)))
    ) ;_  cond
  ) ;_  while
  (princ)
) ;_  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

[fools]

Code: [Select]

;;  Grread+osnap+GRVECS
;;  Rewritten by Fools @ TheSwamp.org
;;  Use (grread) to get original point
;;  Use (osnap) to calculate accurate point
;;  Use (GRVECS) to show AutoSnapMarker
;;  No return , just show the method


Code: [Select]

(DEFUN c:tmp (/       AUTOSNAPMARKERCOLOR       AUTOSNAPMARKERSIZE
      DRAG       GHOSTPT       LST_OSMODE      STR_OSMODE      TIME
      DistPerPixel    Bold       Draftobj       get_osmode      STD-STRTOK
      YPY_GetGrvecs   YPY_DrawVecs
     )
  ;;  CAB  10/5/2006
  ;;  Fools change a little about ","  (3/3/2007)
  ;;
  ;;  Function to return the current osmode setting in the form of a string
  ;;  If (getvar "osmode") = 175
  ;;  (get_osmode)  returns   "_end,_mid,_cen,_nod,_int,_per" 
  (DEFUN get_osmode (/ cur_mode mode$)
    (SETQ mode$ "")
    (IF (< 0 (SETQ cur_mode (GETVAR "osmode")) 16383)
      (MAPCAR (FUNCTION (LAMBDA (x)
  (IF (NOT (ZEROP (LOGAND cur_mode (CAR x))))
    (IF (ZEROP (STRLEN mode$))
      (SETQ mode$ (CADR x))
      (SETQ mode$ (STRCAT mode$ "," (CADR x)))
    )
  )
)
      )
      '((1 "_end")
(2 "_mid")
(4 "_cen")
(8 "_nod")
(16 "_qua")
(32 "_int")
(64 "_ins")
(128 "_per")
(256 "_tan")
(512 "_nea")
(1024 "_qui")
(2048 "_app")
(4096 "_ext")
(8192 "_par")
       )
      )
    )
    mode$
  )
  ;; -------------------------------------------------------------------73
  ;; Tokenizers
  ;; These might be renamed to the long versions:
  ;;   std-string-tokenize, std-string-split and std-string-join
  ;; Converts string with delimiters into string list
  ;; Ignore repeated delims such as white space.
  ;; The order of chars in delim is not important.
  ;; Might be renamed to std-string-tokenize
  ;; Also named lex-string in some Common Lisps.
  ;;   (std-strtok " 2   3 " " ") => ("2" "3")
  ;;   (std-strtok "f 1,3" ", ")  => ("f" "1" "3")
  ;; Same as std-string->strlist
  (DEFUN STD-STRTOK (s delims / len s1 i c lst)
    (SETQ delims (VL-STRING->LIST delims)
  len (STRLEN s)
  s1 ""
  i (1+ len)
    )
    (WHILE (> (SETQ i (1- i)) 0)
      (SETQ c (SUBSTR s i 1))
      (IF (MEMBER (ASCII c) delims)
(IF (/= s1 "") ; no null tokens
  (SETQ lst (CONS s1 lst)
s1  ""
  )
)
(SETQ s1 (STRCAT c s1))
      )
    )
    (IF (/= s1 "")
      (CONS s1 lst) ; no ("" "1" "2")!
      lst
    )
  )
  ;;My functions
  (DEFUN YPY_GetGrvecs (pt dragpt lst / KEY)
    (SETQ key T)
    (WHILE (AND key lst)
      (IF (EQUAL (OSNAP dragpt (CAR lst)) pt 1E-6)
(SETQ key nil)
(SETQ lst (CDR lst))
      )
    )
    (CDR (ASSOC (CAR lst)
'(("_end"
   ((-1 1) (-1 -1))
   ((-1 -1) (1 -1))
   ((1 -1) (1 1))
   ((1 1) (-1 1))
  ) ;square
  ("_mid"
   ((0 1.414) (-1.225 -0.707))
   ((-1.225 -0.707) (1.225 -0.707))
   ((1.225 -0.707) (0 1.414))
  ) ;triangle
  ("_cen"
   ((0 1) (-0.707 0.707))
   ((-0.707 0.707) (-1 0))
   ((-1 0) (-0.707 -0.707))
   ((-0.707 -0.707) (0 -1))
   ((0 -1) (0.707 -0.707))
   ((0.707 -0.707) (1 0))
   ((1 0) (0.707 0.707))
   ((0.707 0.707) (0 1))
  ) ;circle
  ("_nod"
   ((0 1) (-0.707 0.707))
   ((-0.707 0.707) (-1 0))
   ((-1 0) (-0.707 -0.707))
   ((-0.707 -0.707) (0 -1))
   ((0 -1) (0.707 -0.707))
   ((0.707 -0.707) (1 0))
   ((1 0) (0.707 0.707))
   ((0.707 0.707) (0 1))
   ((-1 1) (1 -1))
   ((-1 -1) (1 1))
  ) ;circle+cross
  ("_qua"
   ((0 1.414) (-1.414 0))
   ((-1.414 0) (0 -1.414))
   ((0 -1.414) (1.414 0))
   ((1.414 0) (0 1.414))
  ) ;square rotate 45
  ("_int"
   ((-1 1) (1 -1))
   ((-1 -1) (1 1))
   ((1 0.859) (-0.859 -1))
   ((-1 0.859) (0.859 -1))
   ((0.859 1) (-1 -0.859))
   ((-0.859 1) (1 -0.859))
  ) ;cross
  ("_ins"
   ((-1 1) (-1 -0.1))
   ((-1 -0.1) (0 -0.1))
   ((0 -0.1) (0 -1.0))
   ((0 -1.0) (1 -1))
   ((1 -1) (1 0.1))
   ((1 0.1) (0 0.1))
   ((0 0.1) (0 1.0))
   ((0 1.0) (-1 1))
  ) ;two squares
  ("_per"
   ((-1 1) (-1 -1))
   ((-1 -1) (1 -1))
   ((0 -1) (0 0))
   ((0 0) (-1 0))
  ) ;half square
  ("_tan"
   ((0 1) (-0.707 0.707))
   ((-0.707 0.707) (-1 0))
   ((-1 0) (-0.707 -0.707))
   ((-0.707 -0.707) (0 -1))
   ((0 -1) (0.707 -0.707))
   ((0.707 -0.707) (1 0))
   ((1 0) (0.707 0.707))
   ((0.707 0.707) (0 1))
   ((1 1) (-1 1))
  ) ;circle+line
  ("_nea"
   ((-1 1) (1 -1))
   ((1 -1) (-1 -1))
   ((-1 -1) (1 1))
   ((1 1) (-1 1))
  ) ;two triangle
  ("_qui") ; ???
  ("_app"
   ((-1 1) (-1 -1))
   ((-1 -1) (1 -1))
   ((1 -1) (1 1))
   ((1 1) (-1 1))
   ((-1 1) (1 -1))
   ((-1 -1) (1 1))
  ) ;square+cross
  ("_ext"
   ((0.1 0) (0.13 0))
   ((0.2 0) (0.23 0))
   ((0.3 0) (0.33 0))
  ) ;three points
  ("_par" ((0 1) (-1 -1)) ((1 1) (0 -1))) ;two lines
)
)
    )
  )
  ;;Use GRVECS
  (DEFUN YPY_DrawVecs (Pt Vecs Size Color / lst matrix)
    ;;no Z axis
    (SETQ matrix (LIST (LIST Size 0.0 0.0 (CAR pt))
       (LIST 0.0 Size 0.0 (CADR pt))
       (LIST 0.0 0.0 1.0 0.0)
       (LIST 0.0 0.0 0.0 1.0)
)
    )
    (SETQ lst (MAPCAR 'CONS
      (MAPCAR (FUNCTION (LAMBDA (x) Color)) Vecs)
      Vecs
      )
    )
    (GRVECS (APPLY 'APPEND lst) matrix)
  )
  ;;****************************
  ;;  Main Routine starts here 
  ;;****************************
  (VL-LOAD-COM)
  (SETQ time T)
  (SETQ str_osmode (get_osmode))
  (SETQ lst_osmode (STD-STRTOK str_osmode ","))
  (SETQ Draftobj (VLA-GET-DRAFTING
   (VLA-GET-PREFERENCES (VLAX-GET-ACAD-OBJECT))
)
  )
  (SETQ AutoSnapMarkerSize (VLA-GET-AUTOSNAPMARKERSIZE Draftobj))
  (SETQ AutoSnapMarkerColor (VLA-GET-AUTOSNAPMARKERCOLOR Draftobj))
  (WHILE time
    (GRREAD (SETQ drag (GRREAD T 15 1)))
    (COND ((= (CAR drag) 5)
   (REDRAW)
   (SETQ drag (CADR drag))
   (IF (NULL (SETQ ghostpt (OSNAP drag str_osmode)))
     (SETQ ghostpt drag)
     ;;Beacuse of mouse middle button scroll , calculate "DistPerPixel" every time
     (PROGN (SETQ DistPerPixel (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE"))))
    ;;Bold
    (SETQ Bold (MAPCAR '*
       (LIST DistPerPixel DistPerPixel DistPerPixel)
       (LIST (+ AutoSnapMarkerSize 0.5)
     AutoSnapMarkerSize
     (- AutoSnapMarkerSize 0.5)
       )
       )
    )
    (FOREACH item Bold
      (YPY_DrawVecs
ghostpt
(YPY_GetGrvecs ghostpt drag lst_osmode)
item
AutoSnapMarkerColor
      )
    )
     )
   )
  )
  ((= (CAR drag) 3)
   (IF (NULL (SETQ ghostpt (OSNAP (CADR drag) (get_osmode))))
     (SETQ ghostpt (CADR drag))
   )
   (REDRAW)
   (SETQ time nil)
  )
    )
  )
  (PRINC) ;can return ghostpt if want
)


[fools]

Another solution, combination same data about AUTOSNAPMARKER

Code: [Select]

;;  Grread+osnap+GRVECS
;;  Rewritten by Fools @ TheSwamp.org
;;   
;;  Use (grread) to get original point
;;  Use (osnap) to calculate accurate point
;;  Use (GRVECS) to show AutoSnapMarker
;;  No return , just show the method

(DEFUN c:tmp (/       AUTOSNAPMARKERCOLOR       AUTOSNAPMARKERSIZE
      DRAG       GHOSTPT       LST_OSMODE      STR_OSMODE      TIME
      DistPerPixel    Bold       Draftobj       VecsLst       get_osmode
      sparser       YPY_VecsList    YPY_GetGrvecs   YPY_DrawVecs
     )
  ;;  CAB  10/5/2006
  ;;  Fools change a little about ","  (3/3/2007)
  ;;
  ;;  Function to return the current osmode setting in the form of a string
  ;;  If (getvar "osmode") = 175
  ;;  (get_osmode)  returns   "_end,_mid,_cen,_nod,_int,_per"   
  (DEFUN get_osmode (/ cur_mode mode$)
    (SETQ mode$ "")
    (IF (< 0 (SETQ cur_mode (GETVAR "osmode")) 16383)
      (MAPCAR (FUNCTION (LAMBDA (x)
  (IF (NOT (ZEROP (LOGAND cur_mode (CAR x))))
    (IF (ZEROP (STRLEN mode$))
      (SETQ mode$ (CADR x))
      (SETQ mode$ (STRCAT mode$ "," (CADR x)))
    )
  )
)
      )
      '((1 "_end")
(2 "_mid")
(4 "_cen")
(8 "_nod")
(16 "_qua")
(32 "_int")
(64 "_ins")
(128 "_per")
(256 "_tan")
(512 "_nea")
(1024 "_qui")
(2048 "_app")
(4096 "_ext")
(8192 "_par")
       )
      )
    )
    mode$
  )
  ;;  This one uses pointers
  ;;  written by CAB @ TheSwamp.org
  (DEFUN sparser (str delim / ptr lst stp)
    (SETQ stp 1)
    (WHILE (SETQ ptr (VL-STRING-SEARCH delim str (1- stp)))
      (SETQ lst (CONS (SUBSTR str stp (- (1+ ptr) stp)) lst))
      (SETQ stp (+ ptr 2))
    )
    (REVERSE (CONS (SUBSTR str stp) lst))
  )
  ;;My functions
  ;;Initial Grvecs List
  (DEFUN YPY_VecsList (/ CIRCLE CROSS SQUARE LINE)
    (SETQ square '(((-1 1) (-1 -1) (1 -1) (1 1) (-1 1))))
    (SETQ cross '(((-1 1) (1 -1))
  ((-1 -1) (1 1))
  ((1 0.859) (-0.859 -1))
  ((-1 0.859) (0.859 -1))
  ((0.859 1) (-1 -0.859))
  ((-0.859 1) (1 -0.859))
)
    )
    (SETQ circle '(((0 1)
    (-0.707 0.707)
    (-1 0)
    (-0.707 -0.707)
    (0 -1)
    (0.707 -0.707)
    (1 0)
    (0.707 0.707)
    (0 1)
   )
  )
    )
    (SETQ line '(((1 1) (-1 1))))
    (LIST (CONS "_end" square) ;square
  '("_mid"
    ((0 1.414) (-1.225 -0.707) (1.225 -0.707) (0 1.414))
   ) ;triangle
  (CONS "_cen" circle) ;circle
  (APPEND '("_nod") square cross) ;circle+cross
  '("_qua"
    ((0 1.414) (-1.414 0) (0 -1.414) (1.414 0) (0 1.414))
   ) ;square rotate 45
  (CONS "_int" cross) ;cross
  '("_ins"
    ((-1 1)
     (-1 -0.1)
     (0 -0.1)
     (0 -1.0)
     (1 -1)
     (1 0.1)
     (0 0.1)
     (0 1.0)
     (-1 1)
    )
   ) ;two squares
  '("_per"
    ((-1 1) (-1 -1) (1 -1))
    ((0 -1) (0 0))
    ((0 0) (-1 0))
   ) ;two half square
  (APPEND '("_tan") circle line) ;circle+line
  (APPEND '("_nea") '(((1 -1) (-1 -1))) line cross) ;two line+cross
  '("_qui") ; ???
  (APPEND '("_app") square cross) ;square+cross
  '("_ext"
    ((0.1 0) (0.13 0))
    ((0.2 0) (0.23 0))
    ((0.3 0) (0.33 0))
   ) ;three points
  '("_par" ((0 1) (-1 -1)) ((1 1) (0 -1))) ;two lines rotate 45
    )
  )
  ;;Get Grvecs List
  (DEFUN YPY_GetGrvecs (pt dragpt lst vecs / KEY)
    (SETQ key T)
    (WHILE (AND key lst)
      (IF (EQUAL (OSNAP dragpt (CAR lst)) pt 1E-6)
(SETQ key nil)
(SETQ lst (CDR lst))
      )
    )
    (CDR (ASSOC (CAR lst) vecs))
  )
  ;;Use GRVECS
  (DEFUN YPY_DrawVecs (Pt Vecs Size Color / lst matrix)
    ;;no Z axis
    (SETQ matrix (LIST (LIST Size 0.0 0.0 (CAR pt))
       (LIST 0.0 Size 0.0 (CADR pt))
       (LIST 0.0 0.0 1.0 0.0)
       (LIST 0.0 0.0 0.0 1.0)
)
    )
    (GRVECS (APPLY (FUNCTION APPEND)
   (APPLY (FUNCTION APPEND)
  (MAPCAR (FUNCTION
    (LAMBDA (x)
      (IF (> (LENGTH x) 2)
(MAPCAR (FUNCTION LIST)
(MAPCAR (FUNCTION (LAMBDA (x) Color)) x)
x
(CDR x)
)
(LIST (CONS Color x))
      )
    )
  )
  Vecs
  )
   )
    )
    matrix
    )
  )
  ;;****************************
  ;;  Main Routine starts here   
  ;;****************************
  (VL-LOAD-COM)
  (SETQ time T)
  (SETQ VecsLst (YPY_VecsList))
  (SETQ str_osmode (get_osmode))
  (SETQ lst_osmode (sparser str_osmode ","))
  (SETQ Draftobj (VLA-GET-DRAFTING
   (VLA-GET-PREFERENCES (VLAX-GET-ACAD-OBJECT))
)
  )
  (SETQ AutoSnapMarkerSize (VLA-GET-AUTOSNAPMARKERSIZE Draftobj))
  (SETQ AutoSnapMarkerColor (VLA-GET-AUTOSNAPMARKERCOLOR Draftobj))
  (WHILE time
    (GRREAD (SETQ drag (GRREAD T 1 1))) ;Can change like (grread T 15 2)
    (COND ((= (CAR drag) 5)
   (REDRAW)
   (SETQ drag (CADR drag))
   (IF (OR (ZEROP (STRLEN str_osmode))
   (NULL (SETQ ghostpt (OSNAP drag str_osmode)))
       )
     (SETQ ghostpt drag)
     ;;Beacuse of mouse middle button scroll , calculate "DistPerPixel" every time
     (PROGN (SETQ DistPerPixel (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE"))))
    ;;Bold
    (SETQ Bold (MAPCAR '*
       (LIST DistPerPixel DistPerPixel DistPerPixel)
       (LIST (+ AutoSnapMarkerSize 0.5)
     AutoSnapMarkerSize
     (- AutoSnapMarkerSize 0.5)
       )
       )
    )
    (FOREACH item Bold
      (YPY_DrawVecs
ghostpt
(YPY_GetGrvecs ghostpt drag lst_osmode VecsLst)
item
AutoSnapMarkerColor
      )
    )
     )
   )
  )
  ((= (CAR drag) 3)
   (IF (NULL (SETQ ghostpt (OSNAP (CADR drag) (get_osmode))))
     (SETQ ghostpt (CADR drag))
   )
   (REDRAW)
   (SETQ time nil)
  )
    )
  )
  (PRINC) ;can return ghostpt if u want
)