【飞鸟集】心随我动--为LISP定制的动态输入,拖拉和动态信息函数(更新至20130731)

wfish2000 · 发表于 2011-11-29 16:24:02

高山仰止，景行行止。虽不能至，然心向往之。

liuyj · 发表于 2011-11-30 09:47:20

昨天下载的最终生成日期是29日8点多，今天刚上传的最终生成日期是29日2点多，哪个是最新的？晕了

highflybir · 发表于 2011-11-30 11:34:38

liuyj 发表于 2011-11-30 09:47
昨天下载的最终生成日期是29日8点多，今天刚上传的最终生成日期是29日2点多，哪个是最新的？晕了

本来今天想上传一个最新的，但是后来测试发现有个问题，所以又把昨天的放回去了。

liuyj · 发表于 2011-11-30 13:48:27

其实qjchen的dynamic Array我经常使用，这两个的不同我比较了一下，原来的利用grread的，在光标移动或静止时阵列出来的实体都不晃眼，但改写的程序在光标移动时实体能看见，但很晃眼，光标静止时，就看不到东西了，昨天的最新版好些，但还是有些晃眼

liuyj · 发表于 2011-11-30 13:48:59

补充一点，我用cad2006

highflybir · 发表于 2011-11-30 13:55:29

本帖最后由 highflybir 于 2011-11-30 14:03 编辑

liuyj 发表于 2011-11-30 13:48
补充一点，我用cad2006

可以这样：

(HFB_POINTMONITOR "ArrayCallback")
(getpoint p0 "\nThe end point:")
(HFB_POINTMONITOR)
;;(SSJIG "ArrayCallback" "\nThe end point:" "" (+ 1 2 4 16 128) 3 (trans p0 1 0))

你可以不用ssJIG,而用 pointmonitor，就是把我注释部分去掉，再注释掉SSJIG那句，那样的话，就一点都不会闪。
Pointmonitor要比JIG好和快。在大多数情况下，可以用SSJIG的也可以用Pointmonitor,这两种方法都可以用。

highflybir · 发表于 2011-12-4 09:19:56

程序再次更新，修正了输入的问题，修正了几个可能引起异常的bug，对2007-2009 的64位版本重新编译。如果有朋友用这个版本的CAD，请告知我加载和测试情况。
增加了英文版本。

brainstorm · 发表于 2011-12-4 10:09:09

楼主能讲解一下钩子函数的用法么，谢谢

qjchen · 发表于 2011-12-5 16:53:49

谢谢飞鸟兄的函数

以前，出于对grread的无法捕捉和正交等原因，经常寻找改进这个的方法，所以，经常用一个画曲线上的垂直线的例子来练写代码。

以前利用Alexander Rivilis的DynDraw.Arx函数
http://www.theswamp.org/index.php?topic=9133.0
编写过这个函数
http://www.theswamp.org/index.php?topic=9133.msg395251#msg395251

而后，又采用了.Net的Jig函数来编写这个效果
http://bbs.mjtd.com/thread-84961-1-1.html

Highflybird兄的这个新的Arx出来之后，一直没有时间仔细学习，昨晚在认真学习并请教了高飞兄之后，写下如下代码，可以看出，相比Alexander的DynDraw函数，高飞兄的Arx编写思路更加清晰，代码可以更短。

在此向高飞兄表达崇高的敬意

;;; Thanks to Highflybird very much
;;; 寻找曲线上点的垂直线.
;;; 请先加载Highflybird兄的好函数
;;;
(defun C:test (/ curve l)
(prompt "\n 请先选择一个曲线:")
(setq curve (vlax-ename->vla-object (car (entsel)))
l (vla-addline (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-3D-point '(0 0 0))(vlax-3D-point '(0 0 0)))
)
(ssjig "dyn_call_back" "\n 请选择一点: " "" (+ 1 2 128) 0)
(princ)
)
;;;;画垂直线
(defun dyn_call_back (p / p1 p2)
(setq p1 (vlax-curve-getClosestPointTo curve p)
p2 (polar p1 (+ (/ pi 2) (angle '(0 0 0)
(vlax-curve-getFirstDeriv curve (vlax-curve-getParamAtPoint curve
(vlax-curve-getClosestPointTo curve p))))) (* 0.3 (getvar "viewsize")))
p2a (mapcar '+ p1 (mapcar '- p1 p2)))
(if (< (distance p p2) (distance p p2a))
(progn (vlax-put l 'StartPoint p1) (vlax-put l 'EndPoint p2))
(progn (vlax-put l 'StartPoint p1) (vlax-put l 'EndPoint p2a))
)
)
(princ "\n By [email]qjchen@gmail.com[/email], 利用Highflybird兄的函数，过一点画垂直线，动态，命令test")
(princ)

;;; Thanks to Highflybird very much 
;;; 寻找曲线上点的垂直线. 
;;; 请先加载Highflybird兄的好函数 
;;; 
(defun C:test (/ curve l) 
  (prompt "\n 请先选择一个曲线:") 
  (setq curve (vlax-ename->vla-object (car (entsel))) 
        l (vla-addline (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) 
             (vlax-3D-point '(0 0 0))(vlax-3D-point '(0 0 0))) 
  ) 
  (ssjig "dyn_call_back" "\n 请选择一点: " "" (+ 1 2 128) 0) 
  (princ) 
) 
;;;;画垂直线 
(defun dyn_call_back (p / p1 p2) 
  (setq p1 (vlax-curve-getClosestPointTo curve p) 
        p2 (polar p1 (+ (/ pi 2) (angle '(0 0 0) 
                     (vlax-curve-getFirstDeriv curve (vlax-curve-getParamAtPoint curve 
                        (vlax-curve-getClosestPointTo curve p))))) (* 0.3 (getvar "viewsize"))) 
        p2a (mapcar '+ p1 (mapcar '- p1 p2))) 
  (if (< (distance p p2) (distance p p2a)) 
    (progn (vlax-put l 'StartPoint p1) (vlax-put l 'EndPoint p2)) 
    (progn (vlax-put l 'StartPoint p1) (vlax-put l 'EndPoint p2a)) 
  ) 
) 
(princ "\n By [email]qjchen@gmail.com[/email], 利用Highflybird兄的函数，过一点画垂直线，动态，命令test") 
(princ)

highflybird · 发表于 2011-12-8 18:05:23

另外的一个例子。
递归画正六边形。

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

[【高飞鸟】] 【飞鸟集】心随我动--为LISP定制的动态输入,拖拉和动态信息函数(更新至20130731)

点评

评分

本帖子中包含更多资源