详细分析G版的“自定义带捕捉的grread函数”源代码

bencat9527 · 发表于 2015-4-15 20:04:32

首先感谢论坛的超版 Gu_xl 无私奉献了此源代码，使我能给自己的程序顺利增加了拖放中实现点捕捉的功能。开心之余，也对这个函数本身很好奇，于是就逐句分析了源程序并做了注释，在此记录下来供自己和网友查阅。

再次声明：本文列出的源代码，其版权归明经通道的超版 Gu_xl 所有；原帖地址是： http://bbs.mjtd.com/thread-91191-1-1.html

本人在此只是根据自己的理解对源程序进行了注释和说明；说明和注释有谬误之处尽管拍砖。

另，本文同步发布在本人的博客内。

;;;==================================================================
;;gxl-Sel-ReDrawSel 重画选择集中的对象，Sel 为选择集或图元名 mode 为方式码
;;;重画选择集中的对象，mode 为方式码，
;;;方式码 1 在屏幕重画该选择集对象
;;;方式码 2 隐藏该选择集对象
;;;方式码 3 “醒目显示”该选择集对象
;;;方式码 4 取消“醒目显示”该选择集对象
;;;==================================================================
;;; 笨猫注释：此例程比较简单，主要就是使用了 redraw 函数，遍历选择集里面的每一个实体，对其应用redraw函数；
;;; 注意，redraw函数的第一个参数为实体名，所以要用ssname函数从选择集sel中提取。
;;; 另外，原代码中这个函数的定义是在 gxl-Ge-grread函数定义的里面的，我觉得还是拿出来比较方便；这个例程还是蛮有用的。
;;; 用户没有输入 mode 参数，redraw不会报错
(defun gxl-Sel-ReDrawSel (Sel mode / m n)
(if sel ;;; --> 如果存在sel参数
(progn
(cond ((= 'pickset (type Sel)) ;;; --- > 用type函数判断sel是不是选择集
(setq m (sslength Sel)
n 0)
(repeat m
(redraw (ssname Sel n) mode)
(setq n (1+ n))
)
)
((= 'ename (type Sel)) ;;; ---> 用type函数判断sel是不是实体名
(redraw Sel mode)
)
)
)
)
) ;defun gxl-Sel-ReDrawSel
;;;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
)
;;;分列字串
;;; 笨猫注释：此例程输入参数为字符串str和字符串del,返回一个表，表内的元素分别为del之前的字符串和del之后的字符串
;;;; 例如，输入 (gxl-strparse "abcdefgdef12345" "def") 返回的结果是 ("abc" "g" "12345")
(defun gxl-StrParse ( str del / pos lst )
(while (setq pos (vl-string-search del str)) ;; 找到字串del在字串str中的位置，赋值给pos；注意，字符串的位置序号是从0开始的
(setq lst (cons (substr str 1 pos) lst) ;; 将str中从第1位开始，长度为pos的子字串提取出来，作为一个元素，然后添加到表lst前面,
;;; 并赋值给lst <-- 其实就是截取字串str中del之前的部分作为表lst的一个元素
str (substr str (+ pos 1 (strlen del))) ;; 将str中del之后的部分取出来，并赋值给str；然后执行while循环,判断str中是否存在多个del
)
)
(if (= " " Del) ;; 如果del是空格
(vl-remove "" (reverse (cons str lst)));; 反向排列表lst中的元素并去除字符串中的空格
(reverse (cons str lst)) ;; 反向排列表lst中的元素, ，
)
) ;; 函数gxl-StrParse定义结束
;;;返回捕捉模式字串
;;; 笨猫注释：本例程检测当前的捕捉模式，并返回一个用字符表示的当前有效的捕捉模式，各模式之间用逗号分隔
;;; 例如 "_end,_mid,_cen,_qua,_int,_per,_nea"
;;; 本例程没有输入参数
(DEFUN get_osmode (/ cur_mode mode$)
(SETQ mode$ "")
(IF (< 0 (SETQ cur_mode (GETVAR "osmode")) 16384) ;; if_1 去得当前的osmode值，为0到16384之间的一个整数
;; 注意 < 函数具有2个以上变量时候的用法
(MAPCAR (FUNCTION (LAMBDA (x) ;;; 此处注意lambda(定义无名函数)，function (优化代码)和_
;;; mapcar (对后面的list 中的各元素，应用应用无名函数) 的用法
(IF (NOT (ZEROP (LOGAND cur_mode (CAR x)))) ;;; 此处的重点是 logand函数，将表中的_
;;; 每个元素中的数字拿出来和当前的捕捉模式cur_mode进行“按位与”运算_
;;; 由于捕捉模式的数字定义就是2的N次方，或者相加；根据“按位与”运算_
;;; 的定义，凡是和cur_mode“按位与”运算的结果不为零，就说明被cur_mode包含_
;;; 比如：cur_mode=7，我们知道是1+2+4的结果，那么cur_mode和1、2、4的按位与_
;;; 计算都不等于零，和其他的数字运算则都等于零
(IF (ZEROP (STRLEN mode$))
(SETQ mode$ (CADR x))
(SETQ mode$ (STRCAT mode$ "," (CADR x))) ;;; 只要包含，就将此捕捉模式的文字表述加入到字符串mode$中
);;end if_3
) ;;end if_2
);end lambda
) ;; end function
'((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")
) ;; end list
) ;;end MAPCAR
) ;; end if_1
mode$
)
;;;返回捕捉标记Vecs
;;; 笨猫注释：本例程输入两个点pt 和 dragpt,以及一个表lst，该表的每个元素是一个表示捕捉方式的字符串
;;; 返回值为一个表示点坐标的表，用于在屏幕上绘制表示捕捉的符号
;;; 没有满足条件的值时返回 nil
(DEFUN GetGrvecs (pt dragpt lst / KEY)
(SETQ key T) ;; 引入循环控制变量key
(WHILE (AND key lst) ;; 当lst不为空，且key有效时，执行while
(IF (EQUAL (OSNAP dragpt (CAR lst)) pt 1E-6) ;;; 取出表lst的第一项（是一个捕捉方式），将其用于dragpt，判断是否满足捕捉，并且，返回的点要和pt很接近（误差1*10^-6）
;;; 这里其实有个二次判断，因为参数pt在主例程里面已经是判断过一次的捕捉点；dragpt是鼠标当前位置
(SETQ key nil) ;; 如果满足则退出循环
(SETQ lst (CDR lst)) ;; 不满足则判断lst表中的下一项，直到lst为空
)
)
(CDR (ASSOC (CAR lst) ;;; 从后面定义的关联表LIST中，以lst表中的某一项为关键字搜寻对应的项,并返回该项的第二部分(一个表示点坐标的表)
'(("_end" ;;; 此处开始定义关联表LIST，每一项为关键字+点坐标的表；其中，表示点坐标的表用于后面在屏幕上绘制表示捕捉的符号
((-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))) ;两条线
)
)
)
)
;;绘制捕捉标记
;;; 笨猫注释：本例程在屏幕上绘制一个捕捉标记；
;;; 参数pt为绘制的中心点，Vecs为记录绘制标记的控制点坐标的表例如 vecs =( ((0.1 0) (0.13 0)) ((0.2 0) (0.23 0)) ((0.3 0) (0.33 0)) )
;;; Size为标记的大小，Color为标记的颜色;
(DEFUN DrawVecs (Pt Vecs Size Color / lst xdir)
(setq xdir (getvar 'ucsxdir)) ;; 系统变量ucsxdir 返回一个表示当前UCS中X方向的点，缺省值 (1 0 0)
;; 下面这一段setq vecs代码，本质上是获得以pt点为原点，相对坐标分别为输入参数vecs的各个角点在用户ucs下的坐标
;; 关于CAD的各种坐标系及其变换，以及trans函数的用法，详见明经通道论坛中版主 highflybir 的相关文章
(setq vecs
(mapcar
'(lambda (x)
(mapcar '(lambda (a)
(setq a (trans a 0 xdir)) ;; 通过trans矩阵变换，算出每一个（相对于pt点的）矢量a所对应的用户UCS上的x坐标和y坐标
;; 返回的结果是一个三维坐标点，其中，第一位为y坐标，第二位为z坐标，第三位为x坐标
;; 其实就是a相对于点pt的x增量和y增量
(setq a (list (caddr a) (car a))) ;; 转换为正常的点表
(list (+ (car pt) (* size (car a))) ;;; 取得点a在UCS下的坐标值
(+ (cadr pt) (* size (cadr a)))))
x ;;; 对于x中的每一项，执行无名函数lambda (a);; 例如，a= (0.1 0)
)
)
vecs ;;; 对于vecs中的每一项，执行无名函数lambda (x); 例如，x= ((0.1 0) (0.13 0))
)
);; end setq vecs
;;; 至此，将vecs中的每个点表更新为ucs下的坐标值
;;; 下面的setq lst将vecs中的每个点表前面增加一个color，并返回增加color以后的表
;;; 完成以后的lst应该是 ( (color(0.1 0) (0.13 0)) (color(0.2 0) (0.23 0)) (color(0.3 0) (0.33 0)) ) 【注意，这里假设每个color后面的点对都已经是ucs下的点坐标】
(SETQ lst (MAPCAR 'CONS
(MAPCAR (FUNCTION (LAMBDA (x)
Color)
)
Vecs)
Vecs
)
);;;
(GRVECS (APPLY 'APPEND lst)) ;; 执行append以后，将lst中每个color前面的这一对括号去掉，构成grvevs函数的输入参数
) ;;; 完成在屏幕上绘制
;;;主程序开始
(VL-LOAD-COM)
(if STARTPT ;;; 是否具有startpt参数，没有的话用 lastpoint系统变量代替
(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)) ;_ 执行Gread函数，获得返回值
(setq dragmode (car drag))
(COND
((equal drag '(2 6));F3切换捕捉开关
(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));F8切换正交开关
(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)) ;;; 如果当前捕捉模式关闭或者未设置 IF_MARK_1
(null (SETQ ghostpt (OSNAP drag str_osmode))) ;;; 或者在当前鼠标位置没有需要的捕捉点；也就说，当捕捉有效的时候不执行正交模式
)
;;;此处修改正交模式下坐标
(if (and startpt ;;; 如果同时存在起始点
(= 1 f8) ;;; 正交方式打开
(/= 2 (car drag))) ;;; 不是键盘输入 <--- 此句我觉得有点多余了，因为之前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) ;;; 如果正交关闭，则当前鼠标所在位置坐标传给 ghostpt
) ;; end-if 正交判断
;;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
(DrawVecs
ghostpt ;;; --鼠标所在的点或者是捕捉到的点
(GetGrvecs ghostpt drag lst_osmode) ;; 需要绘制哪种捕捉标记
item ;;; 捕捉框的尺寸，有三种，这里其实是绘制了三遍，用于加粗效果
AutoSnapMarkerColor ;;; 捕捉框的颜色
)
)
)
) ;;; end_IF_MARK_1
(GXL-SEL-REDRAWSEL ss 1) ;_ 显示选择集
) ;;; end drag_mode_5
((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)) ;;; 正交关闭时，返回鼠标拾取的点
) ;; end _if 正交打开
;; 如果捕捉到了需要的点，则ghostpt里面就是捕捉到的点，因此不需要再做处理
) ;; end-if 是否捕捉到需要的点
(REDRAW)
(GXL-SEL-REDRAWSEL ss 1) ;_ 显示选择集
(SETQ time nil)
) ;;;; end dragmode_3
(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)
) ;;; end_T
);;; end cond
; )
(list dragmode ghostpt) ;;; 函数返回输入类型代码和相应的值（比如点或者其他）
) ;;;; 主程序 end-defun
;;;测试1，动态移动
;;; 笨猫注释：用这个测试程序的时候，会发现最开始选择的基点会随着鼠标的拖动出现漂移
;;; 初步判断是倒数第二句的"move"命令造成的，因为执行move的时候 osmode是有效的，有时候
;;; 会出现意想不到的效果。
;;; 另外，此处在循环体里面使用move命令，会造成程序明显运行不畅。
(defun c:tt(/ ss pt p oldpt oldosmode)
(princ "\n选择移动物体: ")
(while (not (setq ss (ssget))))
(setq pt (getpoint "\n 选择基点"))
(if (null pt) (setq oldpt (getvar 'lastpoint)) (setq oldpt pt))
(while (/= 3 (car (setq gr (GXL-GE-GRREAD '(t 7 2) pt ss)))) ;_ 将移动的选择集排除在捕捉目标之外
(if (= 'list (type (setq p (cadr gr))))
(progn
(grdraw pt p 1)
(command "move" ss "" oldpt p)
(setq oldpt p)
)
)
)
)
;;;测试2
(defun c:test (/ en gr p enl)
(while (not (setq p (GETPOINT "\n点："))))
(while (/= 3 (car (setq gr (GXL-GE-GRREAD '(t 7 2) p en)))) ;_ 将直线排除在捕捉目标之外
(if (= 'list (type (cadr gr)))
(progn
(if en
(progn
(entmod (subst (cons 11 (trans (cadr gr) 1 0)) (assoc 11 enl) enl))
)
(progn
(vla-ADDLINE (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point (trans p 1 0)) (vlax-3d-point (trans (cadr gr) 1 0)))
(setq en (entlast) enl (entget en))
)
)
)
)
)
)

;;;================================================================== 
;;gxl-Sel-ReDrawSel 重画选择集中的对象，Sel 为选择集或图元名 mode 为方式码 
;;;重画选择集中的对象，mode 为方式码， 
;;;方式码 1 在屏幕重画该选择集对象 
;;;方式码 2 隐藏该选择集对象 
;;;方式码 3 “醒目显示”该选择集对象 
;;;方式码 4 取消“醒目显示”该选择集对象 
;;;================================================================== 
 
;;; 笨猫注释：此例程比较简单，主要就是使用了 redraw 函数，遍历选择集里面的每一个实体，对其应用redraw函数； 
;;; 注意，redraw函数的第一个参数为实体名，所以要用ssname函数从选择集sel中提取。 
;;; 另外，原代码中这个函数的定义是在 gxl-Ge-grread函数定义的里面的，我觉得还是拿出来比较方便；这个例程还是蛮有用的。 
;;; 用户没有输入 mode 参数，redraw不会报错 
(defun gxl-Sel-ReDrawSel  (Sel mode / m n) 
  (if sel             ;;; --> 如果存在sel参数 
    (progn 
      (cond ((= 'pickset (type Sel))   ;;; --- > 用type函数判断sel是不是选择集 
      (setq m (sslength Sel) 
     n 0) 
      (repeat m 
        (redraw (ssname Sel n) mode) 
        (setq n (1+ n)) 
        ) 
      ) 
     ((= 'ename (type Sel))    ;;; ---> 用type函数判断sel是不是实体名 
      (redraw Sel mode) 
      ) 
     ) 
      ) 
    ) 
  )           ;defun gxl-Sel-ReDrawSel 
 
 
 
 
;;;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 
     ) 
 
 
;;;分列字串 
 
  ;;; 笨猫注释：此例程输入参数为字符串str和字符串del,返回一个表，表内的元素分别为del之前的字符串和del之后的字符串 
  ;;;; 例如，输入 (gxl-strparse "abcdefgdef12345" "def") 返回的结果是 ("abc" "g" "12345") 
(defun gxl-StrParse ( str del / pos lst ) 
  (while (setq pos (vl-string-search del str))  ;; 找到字串del在字串str中的位置，赋值给pos；注意，字符串的位置序号是从0开始的 
    (setq lst (cons (substr str 1 pos) lst)  ;; 将str中从第1位开始，长度为pos的子字串提取出来，作为一个元素，然后添加到表lst前面, 
                                       ;;; 并赋值给lst <-- 其实就是截取字串str中del之前的部分作为表lst的一个元素 
    str (substr str (+ pos 1 (strlen del)))  ;; 将str中del之后的部分取出来，并赋值给str；然后执行while循环,判断str中是否存在多个del 
    ) 
  ) 
  (if (= " " Del) ;; 如果del是空格 
    (vl-remove "" (reverse (cons str lst)));;  反向排列表lst中的元素并去除字符串中的空格 
    (reverse (cons str lst)) ;; 反向排列表lst中的元素, ， 
    ) 
) ;; 函数gxl-StrParse定义结束 
 
   
  ;;;返回捕捉模式字串 
  ;;; 笨猫注释：本例程检测当前的捕捉模式，并返回一个用字符表示的当前有效的捕捉模式，各模式之间用逗号分隔 
  ;;;  例如 "_end,_mid,_cen,_qua,_int,_per,_nea" 
  ;;;  本例程没有输入参数 
  (DEFUN get_osmode (/ cur_mode mode$) 
    (SETQ mode$ "") 
    (IF    (< 0 (SETQ cur_mode (GETVAR "osmode")) 16384) ;; if_1  去得当前的osmode值，为0到16384之间的一个整数 
                                                         ;; 注意 < 函数具有2个以上变量时候的用法 
       
      (MAPCAR (FUNCTION    (LAMBDA    (x)      ;;; 此处注意lambda(定义无名函数)，function (优化代码)和_ 
                             ;;; mapcar (对后面的list 中的各元素，应用应用无名函数) 的用法 
                             (IF (NOT (ZEROP (LOGAND cur_mode (CAR x)))) ;;; 此处的重点是 logand函数，将表中的_ 
                                                       ;;; 每个元素中的数字拿出来和当前的捕捉模式cur_mode进行“按位与”运算_ 
                                                       ;;; 由于捕捉模式的数字定义就是2的N次方，或者相加；根据“按位与”运算_ 
                                                       ;;; 的定义，凡是和cur_mode“按位与”运算的结果不为零，就说明被cur_mode包含_ 
                                                       ;;; 比如：cur_mode=7，我们知道是1+2+4的结果，那么cur_mode和1、2、4的按位与_ 
                                                       ;;; 计算都不等于零，和其他的数字运算则都等于零 
                                 (IF    (ZEROP (STRLEN mode$)) 
                                        (SETQ mode$ (CADR x)) 
                                        (SETQ mode$ (STRCAT mode$ "," (CADR x)))  ;;; 只要包含，就将此捕捉模式的文字表述加入到字符串mode$中 
                                  );;end if_3 
                              ) ;;end if_2 
                           );end lambda 
              ) ;; end function 
          '((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") 
           ) ;; end list 
       ) ;;end MAPCAR 
    ) ;; end if_1 
    mode$ 
  ) 
 
   
  ;;;返回捕捉标记Vecs 
  ;;;  笨猫注释：本例程输入两个点pt 和 dragpt,以及一个表lst，该表的每个元素是一个表示捕捉方式的字符串 
  ;;;  返回值为一个表示点坐标的表，用于在屏幕上绘制表示捕捉的符号 
  ;;;  没有满足条件的值时返回 nil 
  (DEFUN GetGrvecs (pt dragpt lst / KEY) 
    (SETQ key T) ;;  引入循环控制变量key 
    (WHILE (AND key lst)  ;; 当lst不为空，且key有效时，执行while 
      (IF (EQUAL (OSNAP dragpt (CAR lst)) pt 1E-6)  ;;; 取出表lst的第一项（是一个捕捉方式），将其用于dragpt，判断是否满足捕捉，并且，返回的点要和pt很接近（误差1*10^-6） 
                                              ;;; 这里其实有个二次判断，因为参数pt在主例程里面已经是判断过一次的捕捉点；dragpt是鼠标当前位置 
        (SETQ key nil) ;; 如果满足则退出循环 
        (SETQ lst (CDR lst)) ;; 不满足则判断lst表中的下一项，直到lst为空 
      ) 
    ) 
    (CDR (ASSOC    (CAR lst) ;;; 从后面定义的关联表LIST中，以lst表中的某一项为关键字搜寻对应的项,并返回该项的第二部分(一个表示点坐标的表) 
        '(("_end"            ;;; 此处开始定义关联表LIST，每一项为 关键字+点坐标的表 ； 其中，表示点坐标的表用于后面在屏幕上绘制表示捕捉的符号 
           ((-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))) ;两条线 
    
         ) 
     ) 
    ) 
  ) 
 
   
  ;;绘制捕捉标记 
 
  ;;; 笨猫注释：本例程在屏幕上绘制一个捕捉标记； 
  ;;; 参数pt为绘制的中心点，Vecs为记录绘制标记的控制点坐标的表 例如 vecs =( ((0.1 0) (0.13 0)) ((0.2 0) (0.23 0)) ((0.3 0) (0.33 0)) ) 
  ;;; Size为标记的大小，Color为标记的颜色; 
  (DEFUN DrawVecs (Pt Vecs Size Color / lst xdir) 
    (setq xdir (getvar 'ucsxdir))  ;; 系统变量ucsxdir 返回一个表示当前UCS中X方向的点，缺省值 (1 0 0) 
 
    ;; 下面这一段setq vecs代码，本质上是获得以pt点为原点，相对坐标分别为输入参数vecs的各个角点在用户ucs下的坐标 
    ;; 关于CAD的各种坐标系及其变换，以及trans函数的用法，详见明经通道论坛中版主 highflybir 的相关文章 
    (setq vecs 
         (mapcar 
             '(lambda (x) 
                (mapcar '(lambda (a) 
                           (setq a (trans a 0 xdir)) ;; 通过trans矩阵变换，算出每一个（相对于pt点的）矢量a所对应的用户UCS上的x坐标和y坐标 
                                   ;; 返回的结果是一个三维坐标点，其中，第一位为y坐标，第二位为z坐标，第三位为x坐标 
                                   ;; 其实就是a相对于点pt的x增量和y增量 
          
                           (setq a (list (caddr a) (car a))) ;; 转换为正常的点表 
                           (list (+ (car pt) (* size (car a)))  ;;; 取得点a在UCS下的坐标值 
                                 (+ (cadr pt) (* size (cadr a))))) 
                           x ;;; 对于x中的每一项，执行无名函数lambda (a);; 例如，a= (0.1 0) 
      ) 
        ) 
           vecs ;;; 对于vecs中的每一项，执行无名函数lambda (x); 例如，x= ((0.1 0) (0.13 0)) 
    ) 
     );; end setq vecs 
     ;;; 至此，将vecs中的每个点表更新为ucs下的坐标值 
    ;;; 下面的setq lst将vecs中的每个点表前面增加一个color，并返回增加color以后的表 
    ;;; 完成以后的lst应该是 ( (color(0.1 0) (0.13 0)) (color(0.2 0) (0.23 0)) (color(0.3 0) (0.33 0)) ) 【注意，这里假设每个color后面的点对都已经是ucs下的点坐标】 
    (SETQ lst (MAPCAR 'CONS 
                  (MAPCAR (FUNCTION (LAMBDA (x) 
                  Color) 
            ) 
        Vecs) 
                  Vecs 
              ) 
    );;;   
    
    (GRVECS (APPLY 'APPEND lst)) ;;  执行append以后，将lst中每个color前面的这一对括号去掉，构成grvevs函数的输入参数 
  ) ;;; 完成在屏幕上绘制 
   
  ;;;主程序开始 
  (VL-LOAD-COM) 
  (if STARTPT     ;;; 是否具有startpt参数，没有的话用 lastpoint系统变量代替 
    (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)) ;_ 执行Gread函数，获得返回值 
  (setq dragmode (car drag))   
    (COND 
 
      ((equal drag '(2 6));F3切换捕捉开关 
      (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));F8切换正交开关 
      (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)) ;;; 如果当前捕捉模式关闭或者未设置  IF_MARK_1 
               (null (SETQ ghostpt (OSNAP drag str_osmode))) ;;; 或者在当前鼠标位置没有需要的捕捉点 ；也就说，当捕捉有效的时候不执行正交模式 
            ) 
        ;;;此处修改正交模式下坐标 
           (if (and startpt   ;;; 如果同时存在 起始点 
        (= 1 f8)  ;;; 正交方式打开 
        (/= 2 (car drag)))  ;;; 不是键盘输入  <--- 此句我觉得有点多余了，因为之前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) ;;; 如果正交关闭，则当前鼠标所在位置坐标传给 ghostpt 
             ) ;; end-if 正交判断 
    
         ;;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 
                         (DrawVecs 
                               ghostpt   ;;; --鼠标所在的点或者是捕捉到的点 
                               (GetGrvecs ghostpt drag lst_osmode) ;; 需要绘制哪种捕捉标记 
                                item     ;;; 捕捉框的尺寸，有三种，这里其实是绘制了三遍，用于加粗效果 
                                AutoSnapMarkerColor  ;;; 捕捉框的颜色 
                          ) 
                     ) 
              ) 
           ) ;;; end_IF_MARK_1 
       
       (GXL-SEL-REDRAWSEL ss 1) ;_ 显示选择集 
      )  ;;; end drag_mode_5 
 
 
 
       
      ((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))  ;;; 正交关闭时，返回鼠标拾取的点 
           )  ;;  end _if 正交打开 
 
  ;;  如果捕捉到了需要的点，则ghostpt里面就是捕捉到的点，因此不需要再做处理 
    
        )  ;;  end-if 是否捕捉到需要的点 
 
 
       
       (REDRAW) 
       (GXL-SEL-REDRAWSEL ss 1) ;_ 显示选择集 
       (SETQ time nil) 
       
      ) ;;;; end dragmode_3 
 
       
     (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) 
       )  ;;; end_T 
    );;; end cond 
; ) 
(list dragmode ghostpt)   ;;; 函数返回输入类型代码和相应的值（比如点或者其他） 
   
) ;;;; 主程序 end-defun 
 
 
 
;;;测试1，动态移动 
 
;;; 笨猫注释：用这个测试程序的时候，会发现最开始选择的基点会随着鼠标的拖动出现漂移 
 ;;; 初步判断是倒数第二句的"move"命令造成的，因为执行move的时候 osmode是有效的，有时候 
;;;   会出现意想不到的效果。 
;;; 另外，此处在循环体里面使用move命令，会造成程序明显运行不畅。 
(defun c:tt(/ ss pt p oldpt oldosmode) 
  (princ "\n选择移动物体: ") 
  (while (not (setq ss (ssget)))) 
  (setq pt (getpoint "\n 选择基点")) 
  (if (null pt) (setq oldpt (getvar 'lastpoint)) (setq oldpt pt)) 
  (while (/= 3 (car (setq gr (GXL-GE-GRREAD '(t 7 2) pt ss)))) ;_ 将移动的选择集排除在捕捉目标之外 
    (if (= 'list (type (setq p (cadr gr)))) 
      (progn 
(grdraw pt p 1) 
(command "move" ss "" oldpt p) 
(setq oldpt p) 
) 
      ) 
    ) 
) 
;;;测试2 
(defun c:test (/ en gr p enl) 
(while (not (setq p (GETPOINT "\n点：")))) 
(while (/= 3 (car (setq gr (GXL-GE-GRREAD '(t 7 2) p en)))) ;_ 将直线排除在捕捉目标之外 
  (if (= 'list (type (cadr gr))) 
  (progn 
    (if en 
    (progn 
    (entmod (subst (cons 11 (trans (cadr gr) 1 0)) (assoc 11 enl) enl)) 
    ) 
    (progn 
    (vla-ADDLINE  (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point (trans p 1 0)) (vlax-3d-point (trans (cadr gr) 1 0))) 
    (setq en (entlast) enl (entget en)) 
    ) 
    ) 
    ) 
    ) 
  ) 
   
  )

冰之绝恋 · 发表于 2015-4-15 21:54:50

很强大！一度为水平不够看不懂G版代码而遗憾，这下可以慢慢琢磨了~

singlewu · 发表于 2019-8-16 09:58:32

感谢分享，学习进步

白丝折纸 · 发表于 2019-11-25 14:49:27

感谢分享，非常强大

panliang9 · 发表于 2019-11-25 16:13:59

带捕捉，标记一个，原来说不能捕捉，是不是就可以用这个来改造了。

yoyoho · 发表于 2019-11-26 13:36:01

谢谢分享，学习进步 !!!!!

672505821 · 发表于 2022-1-30 16:12:38

感谢分享，学习进步

473734642 · 发表于 2023-8-24 16:59:37

xzd716 · 发表于 2024-1-7 10:05:17

感谢 Gu_xl 无私奉献！感谢bencat9527分享！

寒潮大冬瓜 · 发表于 2024-5-15 23:34:59

很好→很棒！很好~很棒！！很好……很棒！！！

账号		自动登录	找回密码
密码			注册

[讨论] 详细分析G版的“自定义带捕捉的grread函数”源代码

评分

相关帖子