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

flythinking · 发表于 2021-8-22 15:24:45

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

言戲無軍 · 发表于 2021-8-22 19:40:59

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

大佬 DynDraw 在哪下呢

edsion24 · 发表于 2021-8-23 08:48:18

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

海盗曹 · 发表于 2021-8-23 15:55:01

好东西，赶紧mark一下

caoyin · 发表于 2021-8-24 01:08:25

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

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

言戲無軍 · 发表于 2021-8-28 15:09:06

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

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

unclearriver · 发表于 2021-8-29 00:04:51

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

brainstorm · 发表于 2021-8-30 12:18:20

本帖最后由 brainstorm 于 2021-8-30 13:22 编辑

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

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

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

liuyj · 发表于 2021-8-30 20:36:15

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

liuyj · 发表于 2021-9-2 17:28:32

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

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

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

点评

点评

本帖子中包含更多资源

点评

评分

点评