grread使用例子 lisp_晓东CAD家园-论坛-A/VLISP-心随我动-为LISP定制的动态输入，动态拖拉和动态信息函数（更新至12.15）-源码已经贴在ObjectArx版块处！！http:...

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有帐号？立即注册

x

本帖最后由 Highflybird 于 2013-5-7 00:51 编辑

源码已经贴在ObjectArx版块处！！

http://bbs.xdcad.net/thread-667837-1-1.html

arx程序和LISP样例：

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:DynamicLisp.rar

下载次数:197  文件大小:296 KB

下载权限: 不限以上  [免费赚D豆]

===========================================

12.9日更新，先附上beta版本，等各位测试后没问题，再替换。

增加了开关函数。具体演示如下：

Toggle.gif (133.37 KB, 下载次数: 4)

2013-5-7 00:36 上传

===========================================

12.4更新,修正了动态输入的问题。消除了可能引起异常的几个bug.

增加了英文版本。===========================================11.29更新，修正了几个bug。增加了钩子和定时器。请重新下载新的arx和LISP.

现在可以卸载时候不弹出对话框和使得CAD崩溃了。

(setLIsptimer 回调函数 毫秒数)    ;增加一个定时器事件

(KillLispTimer)     ;关闭定时器

(RegisterHook  回调函数)  ；注册一个钩子

(removeHook)   ；移除钩子

===========================================

11.21更新，增加了R2000-2002版本。增加了几个新的函数。请重新下载新的arx和LISP.

(GetAperture)     ;靶框下的图元列表(GetOSMode)     ;当前的捕捉模式(非系统变量)

(GetNested)      ;嵌套选择的图元列表===========================================

ARX已经更新，有反映R2004不能用的请重新下载，并请反馈测试结果。

新增加R2007,R2008,R2009的64位版本。(dynArxFor2007-2009x64.arx)===========================================

虽说LISP中已经提供了动态的输入采集函数grread，然而这个函数有诸多不足，譬如不支持捕捉，正交及动态输入。不能在图形外的菜单等处操作。等等。

而且在一定情况下受速度限制。

为此，我特意编写了几个函数，极大程度地扩张了CAD的动态函数。

有了这几个函数，你就可以自由地拖拉物体，既支持捕捉，也支持正交，等等。

还可以定制自己的tooltip(热信息),定制自己的光标(这个光标可以是CAD的任何图元);

可以随时采集输入信息，甚至可以让GetPoint,SSGet之类的函数能带有回调。

用法，先依据自己的CAD版本，加载相应的arx，然后运行附件中的测试样例。

1.gif (670.31 KB, 下载次数: 4)

2013-5-7 00:39 上传

说明：

这个arx提供了四个主要函数HFB_PointMonitor， SSJIG ， DragGen ， XFormSS.其用法介绍参见下面的帖子。

其中以HFB_PointMonitor效果最好，SSJIG能动态输入，DragGen和XFormSS可执行大量选择集的变换。

这些函数在R2012版本上效果最好。

帖子会随时更新源码和演示，欢迎大家提意见，或者把自己的样例放上来。我会为样例加分。

在编写这个程序中，得到了FSXM的很多建议和支持，在此深表感谢。

一、输入点监视函数HFB_PointMonitor

用来动态采集CAD中光标的位置，并反馈给用户处理。这样以来，你就可以拥有自己的鼠标。

用来动态采集Getpoint,getangle,getdist,getorient,getcorner,entsel,nentsel,nentselp,ssget之类的函数时光标所在位置，并对其反应，形成各种特殊的效果，譬如动态拖拉，动态信息等等。

这个函数的优点在于，回调函数不一定要在命令状态下就可以运行，就像非模态一样。

[pcode=lisp,true]

(vl-load-com)

(if (null CurDoc)

(setq CurDoc

(vla-get-ActiveDocument (vlax-get-acad-object)))

)

;;;*********************************************************************

;;;HFB_PointMonitor用法:

;;;(HFB_PointMonitor [回调函数] [选择集/图元])

;;;不带参数的(HFB_PointMonitor)为关闭监视事件

;;;第一个参数为回调函数名称，应该为字符串，且存在的函数

;;;回调函数只有一个参数，这个参数为三维点，代表你现在鼠标所在位置.如果返

;;;回值为选择集或者图元，将更改鼠标捕捉排除的物体为你返回值所代表的物体.

;;;如果返回值为字符串，说明将把字符串的信息附加到CAD的tooltip上。

;;;第二个参数可以缺省，缺省的话，将不排除鼠标捕捉,不过你以后仍可指定.

;;;*********************************************************************

;;;*********************************************************************

;;;图元信息显示

;;;*********************************************************************

(defun c:Info(/ ret)

(defun InfoCallback (dynpt / txt lst dat)

(setq txt (vl-princ-to-string (mapcar 'rtos dynpt)))

(setq txt (strcat "\n当前点的坐标是：" txt))

(if (setq lst (nentselp dynpt))

(progn

(setq dat (entget (car lst)))

(strcat txt "\n这个图元的类型是：" (cdr (assoc 0 dat)))

)

txt

)

)

(setq ret (HFB_PointMonitor "InfoCallback"))

(prompt "\n如果要关闭监视，请用函数(HFB_PointMonitor)")

(princ)

)

;;;*********************************************************************

;;;自定义光标

;;;*********************************************************************

(defun C:MyCursorOn(/ ret ent)      ;打开光标

(defun CursorCallback (dynpt / height insPnt)

(if (not (vlax-erased-p txtobj))

(progn

(setq height (/ (getvar 'viewsize) 50))

(setq insPnt (mapcar '+ dynpt (list (/ height 2) (/ height 2) 0)))

(vlax-put txtobj 'InsertionPoint inspnt)

(vlax-put txtobj 'height  height)

)

(HFB_PointMonitor)

)

)

(setq ent (entmakex

(list

'(0 . "text")

'(1 . "highflybird")

'(62 . 3)

(cons 10 (getvar 'lastpoint))

(cons 40 (/ (getvar 'viewsize) 50))   ;for a standard dwg

)

)

)

(setq txtobj (vlax-ename->vla-object ent))

(setq ret (HFB_PointMonitor "CursorCallback" ent))

(prompt "\n如果要关闭自定义光标，请用命令MyCursorOff.")

(princ)

)

(defun C:MyCursorOff(/ ret)      ;关闭光标

(HFB_PointMonitor)

(and (not (vlax-erased-p txtobj)) (vla-erase txtobj))

(setq txtobj nil)

(princ)

)

;;;*********************************************************************

;;;带回调函数的GetXXX测试(模拟move命令)

;;;*********************************************************************

(defun C:GetXXX(/ OBJLST P0 PT SS)

(setq *error*_Old *error*)      ;保存出错处理函数

(setq *error* *error*_New)      ;设置新的出错处理

(defun PointCallback (dynpt)      ;回调函数

(foreach obj objlst

(vla-move obj (vlax-3d-point p0) (vlax-3d-point dynpt))  ;移动物体

)

(setq p0 dynpt)

)

(vla-StartUndoMark CurDoc)      ;撤销编组开始

(if (and (setq ss (ssget))

(setq pt (getpoint "\n第一点(1st Point): "))

)

(progn

(setq objlst (GetObjects ss))

(setq p0 (trans pt 1 0))      ;需要转化到世界坐标系

;;设置回调函数名和需要排除捕捉的选择集

(setq ret (HFB_PointMonitor "PointCallback" ss))   ;第一个参数是回调函数名，第二个参数是可以省略(如果不需要排除捕捉的话)

;;现在就可以看到动态效果了

(setq ret (getpoint pt "\n第二点(2nd point): "))   ;此处可以是lisp的交互函数，例如getpoint,getangle之类。

;;最后关闭监视

(HFB_PointMonitor)

(princ ret)

)

)

(vla-EndUndoMark curdoc)      ;编组结束

(princ)

)[/pcode]