另类：带捕捉、正交、极轴的grread函数--.NET测试版V1.0--8月28更新

flythinking

大侠再出精品，必须赞，非常给力！

言戲無軍

caoyin 发表于 2021-8-20 13:59
很久没来，一打开网页就看见大神的帖子，膜拜
以前一直用老毛子的ARX程序——DynDraw，跟楼主的功能 ...

大佬 DynDraw 在哪下呢

edsion24

命令: aj
开始按键测试：<按ESC键卸载退出>无函数定义: GL:KEYMONITOR
缺少函数呢

海盗曹

好东西，赶紧mark一下

caoyin

言戲無軍 发表于 2021-8-22 19:40
大佬 DynDraw 在哪下呢

http://www.maestrogroup.com.ua/support/dyndraw.zip

言戲無軍

caoyin 发表于 2021-8-24 01:08
http://www.maestrogroup.com.ua/support/dyndraw.zip

感谢版主，测试了下，如果dyn_call_back 函数里面 更新实体对象 比如块的话比较容易崩溃，按照样例用grdraw，绘制临时的线什么图像还是可以，用高飞鸟大师的函数感觉稍微好点。

unclearriver

厉害啊............

brainstorm

我的动态拖动函数 2012以上可用

1. (defun c:t1(/ txtobj p loop rtnjig)
   
2.   
   
3.   ;;选择文字
   
4.   (setq txtobj
   
5.     (vlax-ename->vla-object
   
6.       (car(entsel"\n选择文字"))
   
7.     )
   
8.   )
   
9.   
   
10.   ;;创建选择集
    
11.   (setq ss (ssadd))
    
12.   (setq ss
    
13.     (ssadd
    
14.       (vlax-vla-object->ename txtobj)ss)
    
15.   )
    
16.   
    
17.   ;;回调函数  
    
18.   (defun callback1(p)
    
19.     (vla-put-TextString txtobj
    
20.       (rtos (car p)2 3)
    
21.     )
    
22.     ;;方法1 更新图元
    
23.     ;(vla-Update txtobj)
    
24.     ;t
    
25.     ;;方法2：更新，需要返回选择集ss
    
26.     ss
    
27.   )
    
28.   
    
29.   ;;定义一个lisp函数
    
30.   (vl-acad-defun "callback1")
    
31.   
    
32.   ;;基点取上一点
    
33.   (setq p (getvar "LASTPOINT"))
    
34.   
    
35.   ;;循环打开
    
36.   (setq loop t)
    
37.   
    
38.   ;;开始循环
    
39.   (while loop
    
40.     (setq rtnjig
    
41.       (gx:drawjig    ;gx:drawjig
    
42.         ;; 回调函数
    
43.         "callback1"
    
44.         ;; 提示字符串
    
45.         "\n拖动鼠标测试: "
    
46.         ;; Keyword string
    
47.         ;;"A_A测试关键字;S_S测试关键字S"
    
48.         "S _ S;A _ A"
    
49.         ;; 接受3dpoint
    
50.         (+ 2 128 2048)                  
    
51.         ;; 光标类型
    
52.         2
    
53.         ;; 基点
    
54.         p
    
55.       )
    
56.     )
    
57. 
    
58.     (cond
    
59.       ;;用户选择了点
    
60.       ((eq (type rtnjig) 'list)
    
61.         (progn
    
62.           (setq loop nil)
    
63.           (vla-Update txtobj)
    
64.           (princ "\n程序结束")
    
65.           (princ)
    
66.           (setq p rtnjig)
    
67.         )
    
68.       )
    
69.       
    
70.       ;;用户键入关键字
    
71.       ((eq rtnjig "A")
    
72.         (progn
    
73.           (princ "\n关键字A")
    
74.           (princ)
    
75.           (setq loop t)
    
76.         )
    
77.       )
    
78.       
    
79.       ;;用户键入关键字
    
80.       ((eq rtnjig "S")
    
81.         (progn
    
82.           (princ "\n关键字S")
    
83.           (princ)
    
84.           (setq loop t)
    
85.         )
    
86.       )
    
87.       
    
88.       ;;用户按右键，空字符
    
89.       ((eq rtnjig "")
    
90.         (progn
    
91.           ((vla-Update txtobj)
    
92.             (setq loop nil)
    
93.           )
    
94.         )
    
95.       )
    
96.       
    
97.       ;;用户取消，esc键
    
98.       ((not rtnjig)
    
99.         (progn
    
100.           ((vla-Update txtobj)
     
101.             (setq loop nil)
     
102.           )
     
103.         )
     
104.       )
     
105.     );end of cond
     
106.   );end of while loop
     
107. )
     
108. 
     
109. ;;测试dragmove，作用同acet函数dragmove
     
110. (defun c:t2(/ ss ss_erase pt)
     
111.   
     
112.   ;;删除选择集
     
113.   (defun ss_erase (ss / i)
     
114.     (setq i -1)
     
115.     (repeat (sslength ss)
     
116.       (entdel (ssname ss (setq i (1+ i))))
     
117.     )
     
118.   )
     
119.   
     
120.   ;;选择移动的图元
     
121.   (setq ss (ssget))
     
122.   (setq pt (getpoint"\选择基点:"))
     
123.   (if
     
124.     (not
     
125.       (gx:ss:dragmove
     
126.         ss
     
127.         pt
     
128.         "\n标注位置："
     
129.       )
     
130.     )
     
131.     (ss_erase ss)
     
132.   )
     
133. )
     

(defun c:t1(/ txtobj p loop rtnjig)<br />   <br />   ;;选择文字<br />   (setq txtobj<br />     (vlax-ename->vla-object<br />       (car(entsel"\n选择文字"))<br />     )<br />   )<br />   <br />   ;;创建选择集<br />   (setq ss (ssadd))<br />   (setq ss<br />     (ssadd<br />       (vlax-vla-object->ename txtobj)ss)<br />   )<br />   <br />   ;;回调函数  <br />   (defun callback1(p)<br />     (vla-put-TextString txtobj <br />       (rtos (car p)2 3)<br />     )<br />     ;;方法1 更新图元<br />     ;(vla-Update txtobj)<br />     ;t<br />     ;;方法2：更新，需要返回选择集ss<br />     ss<br />   )<br />   <br />   ;;定义一个lisp函数<br />   (vl-acad-defun "callback1")<br />   <br />   ;;基点取上一点<br />   (setq p (getvar "LASTPOINT"))<br />   <br />   ;;循环打开<br />   (setq loop t)<br />   <br />   ;;开始循环<br />   (while loop<br />     (setq rtnjig <br />       (gx:drawjig    ;gx:drawjig<br />         ;; 回调函数<br />         "callback1"<br />         ;; 提示字符串<br />         "\n拖动鼠标测试: "<br />         ;; Keyword string<br />         ;;"A_A测试关键字;S_S测试关键字S"<br />         "S _ S;A _ A"<br />         ;; 接受3dpoint<br />         (+ 2 128 2048)                   <br />         ;; 光标类型<br />         2<br />         ;; 基点<br />         p<br />       )<br />     )<br /> <br />     (cond<br />       ;;用户选择了点<br />       ((eq (type rtnjig) 'list)<br />         (progn<br />           (setq loop nil)<br />           (vla-Update txtobj)<br />           (princ "\n程序结束")<br />           (princ)<br />           (setq p rtnjig)<br />         )<br />       )<br />       <br />       ;;用户键入关键字<br />       ((eq rtnjig "A")<br />         (progn<br />           (princ "\n关键字A")<br />           (princ)<br />           (setq loop t)<br />         )<br />       )<br />       <br />       ;;用户键入关键字<br />       ((eq rtnjig "S")<br />         (progn<br />           (princ "\n关键字S")<br />           (princ)<br />           (setq loop t)<br />         )<br />       )<br />       <br />       ;;用户按右键，空字符<br />       ((eq rtnjig "")<br />         (progn<br />           ((vla-Update txtobj)<br />             (setq loop nil)<br />           )<br />         )<br />       )<br />       <br />       ;;用户取消，esc键<br />       ((not rtnjig)<br />         (progn<br />           ((vla-Update txtobj)<br />             (setq loop nil)<br />           )<br />         )<br />       )<br />     );end of cond<br />   );end of while loop<br /> )<br /> <br /> ;;测试dragmove，作用同acet函数dragmove<br /> (defun c:t2(/ ss ss_erase pt)<br />   <br />   ;;删除选择集<br />   (defun ss_erase (ss / i) <br />     (setq i -1)<br />     (repeat (sslength ss) <br />       (entdel (ssname ss (setq i (1+ i))))<br />     )<br />   )<br />   <br />   ;;选择移动的图元<br />   (setq ss (ssget))<br />   (setq pt (getpoint"\选择基点:"))<br />   (if <br />     (not <br />       (gx:ss:dragmove <br />         ss<br />         pt<br />         "\n标注位置："<br />       )<br />     )<br />     (ss_erase ss)<br />   )<br /> )<br />

liuyj

就拖动的功能而言，与前的大作动态复制相比，效果真的不错，拖动时显示完整，速度也很快，还能一键关键字，就是输入数字时经常丢数，如果用这个做一个动态复制，应该比之前的好用。动态复制4.0的问题一是不能一键关键字，二是拖动时有时显示不全。

liuyj

运行动态多功能移动时，按esc键或右键取消时很容易崩溃