函数类 - 详细分析G版的“自定义带捕捉的grread函数”源代码（整理版） - 《技术博客》

(defun gxl-Sel-ReDrawSel(Sel mode / m n)
  (if sel
    (progn
      (cond
                ((= 'pickset (type Sel))
                    (setq m (sslength Sel) n 0)
                    (repeat m (redraw (ssname Sel n) mode) (setq n (1+ n)))
                )
                ((= 'ename (type Sel)) (redraw Sel mode))
            )
        )
    )
)
;;;gxl-Ge-grread 自定义带捕捉的GrRead函数
;;;参数:GR_MODE = 函数GrRead的参数表 如: (list [track] [allkeys [curtype]),参数个数按需要设置，可为nil
;;;     STARTPT = 基点，计算垂足点、正交模式等坐标的基点,若为nil,则基点默认为系统变量LastPoint值
;;;     SS = 捕捉避开的物体，可以是选择集或图元名
(defun gxl-Ge-grread (gr_mode startpt ss / get_osmode getgrvecs drawvecs time f3 f8 str_osmode lst_osmode draftobj autosnapmarkersize autosnapmarkercolor drag dragmode ghostpt x0 y0 x1 y1 z1 distperpixel bold)
    (defun gxl-StrParse ( str del / pos lst )
        (while (setq pos (vl-string-search del str))
            (setq lst (cons (substr str 1 pos) lst) str (substr str (+ pos 1 (strlen del))))
        )
        (if (= " " Del) (vl-remove "" (reverse (cons str lst))) (reverse (cons str lst)))
    )
  (defun get_osmode (/ cur_mode mode$) 
    (setq mode$ "") 
    (if (< 0 (setq cur_mode (getvar "osmode")) 16384) (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$
  )
  (defun 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)) 
                             )            ;正方形 
                            ("_mid" 
                                ((0 1.414) (-1.225 -0.707)) 
                                ((-1.225 -0.707) (1.225 -0.707)) 
                                ((1.225 -0.707) (0 1.414)) 
                            )            ;三角形 
                            ("_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)) 
                            )            ;圆 
                            ("_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)) 
                            )            ;圆+十字交叉 
                            ("_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)) 
                            )            ;旋转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)) 
                            )            ;十字交叉 
                            ("_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)) 
                            )            ;两个正方形 
                            ("_per" 
                                ((-1 1) (-1 -1)) 
                                ((-1 -1) (1 -1)) 
                                ((0 -1) (0 0)) 
                                ((0 0) (-1 0)) 
                            )            ;半个正方形 
                            ("_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)) 
                            )            ;园+线 
                            ("_nea" 
                                ((-1 1) (1 -1)) 
                                ((1 -1) (-1 -1)) 
                                ((-1 -1) (1 1)) 
                                ((1 1) (-1 1)) 
                            )            ;两个三角形
                            ("_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)) 
                            )            ;正方形+十字交叉 
                            ("_ext" 
                                ((0.1 0) (0.13 0)) 
                                ((0.2 0) (0.23 0)) 
                                ((0.3 0) (0.33 0)) 
                            )            ;三个点 
                            ("_par" ((0 1) (-1 -1)) ((1 1) (0 -1))) ;两条线
                        ) 
                 ) 
    ) 
  )
  (defun DrawVecs (Pt Vecs Size Color / lst xdir) 
    (setq xdir (getvar 'ucsxdir))
    (setq vecs (mapcar '(lambda (x) (mapcar '(lambda (a) (setq a (trans a 0 xdir)) (setq a (list (caddr a) (car a))) (list (+ (car pt) (* size (car a))) (+ (cadr pt) (* size (cadr a))))) x)) vecs))
    (setq lst (mapcar 'cons (mapcar (function (lambda (x) Color)) Vecs) Vecs))
    (grvecs (apply 'append lst))
  )
  (vl-load-com)
  (if STARTPT
    (setvar 'lastpoint STARTPT)
    (setq STARTPT (getvar 'lastpoint))
    )
  (setq time T)
  (setq F3 (getvar "osmode"))
  (setq F8 (getvar "ORTHOMODE"))
  (setq str_osmode (get_osmode))
  (setq lst_osmode (gxl-StrParse 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))
  (setq drag (apply 'grread GR_mode))
  (setq dragmode (car drag))  
    (cond
        ((equal drag '(2 6))
      (if (< f3  16384)
                (progn (setq f3 (+ f3 16384))(prompt "\n<对象捕捉 关>"))
        (progn (setq f3 (- f3 16384))(prompt "\n<对象捕捉 开>"))
            )
      (setvar "OSMODE" f3)(redraw)
        )
        ((equal drag '(2 15))
      (if (= f8 0)
        (progn(setq f8 1)(prompt "\n<正交 开>"))
        (progn(setq f8 0)(prompt "\n<正交 关>"))
            )
            (setvar "orthomode" f8)(redraw)
        )
        ((= dragmode 5)
            (redraw)
            (gxl-Sel-ReDrawSel ss 2)
            (setq drag (cadr drag))
            (if (or (zerop (strlen str_osmode)) (null (setq ghostpt (osnap drag str_osmode))))
                (if (and startpt (= 1 f8) (/= 2 (car drag)))
                    (progn
                        (setq x0 (car startpt) y0 (cadr startpt) x1 (car drag) y1 (cadr drag) z1 (caddr drag))
                        (if (> (abs (- x0 x1)) (abs (- y0 y1)))
                            (setq ghostpt (list x1 y0 z1))
                            (setq ghostpt (list x0 y1 z1))
                        )
                    )
                    (setq ghostpt drag)
                )
                (progn (setq DistPerPixel (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
                    (setq Bold (mapcar '* (LIST DistPerPixel DistPerPixel DistPerPixel) (list (+ AutoSnapMarkerSize 0.5) AutoSnapMarkerSize (- AutoSnapMarkerSize 0.5)))) 
                    (foreach item  Bold (DrawVecs ghostpt (GetGrvecs ghostpt drag lst_osmode) item AutoSnapMarkerColor)) 
                ) 
            )
            (gxl-Sel-ReDrawSel ss 1)
        )
        ((or (= dragmode 3) (= dragmode 12))
            (gxl-Sel-ReDrawSel ss 2)
            (IF (Null (setq ghostpt (OSNAP (CADR drag) (get_osmode))))
                (if (and startpt (= 1 f8) (/= 2 (car drag)))
                    (progn
                        (setq x0 (car startpt)
                            y0 (cadr startpt)
                            x1 (caadr drag)
                            y1 (cadadr drag)
                            z1 (caddar (cdr drag))
                        )
                        (if (> (abs (- x0 x1)) (abs (- y0 y1)))
                            (setq ghostpt (list x1 y0 z1))
                            (setq ghostpt (list x0 y1 z1))
                        )
                    )
                    (setq ghostpt (CADR drag))
                )
            )
            (REDRAW)
            (gxl-Sel-ReDrawSel ss 1)
            (setq time nil)
        )
        (t
            (if (and startpt (= 1 f8) (/= 2 (car drag)))
                (progn
                    (setq x0 (car startpt)
                        y0 (cadr startpt)
                        x1 (caadr drag)
                        y1 (cadadr drag)
                        z1 (caddar (cdr drag))
                    )
                    (if (> (abs (- x0 x1)) (abs (- y0 y1)))
                        (setq ghostpt (list x1 y0 z1))
                        (setq ghostpt (list x0 y1 z1))
                    )
                )
                (setq ghostpt (CADR drag))
            )
            (REDRAW)
        )
    )
    (list dragmode ghostpt)
)