改成程序启动后对象捕捉，对象追踪都关闭，程序结束后对象捕捉，对象追踪都恢复
(defun c:Tt (/ E ENEW NV P S)(princ "\n 数字递增复制")
(if (and (setq e (car (entsel "\nSelect Text: ")))
(setq e (vlax-ename->vla-object e))
(or (= "AcDbText" (vla-get-ObjectName e))
(= "AcDbMText" (vla-get-ObjectName e))
)
)
(progn
(setq s (vla-get-TextString e))
(if (null (setq nv (getreal (strcat "\nNew value:" "<1>"))))
(setq nv 1)
)
(princ "\nCopy to: ")
(while (setq p (getpoint))
(setq enew (vla-copy e))
(vla-put-textstring enew (setq s (rtos (+ (atof s) nv) 2)))
(vla-put-InsertionPoint enew (vlax-3d-point p))
)
)
(princ "\n选中的不是文本或没有选择到实体.")
)
(princ)
)
改成程序启动后对象捕捉，对象追踪都关闭，程序结束后对象捕捉，对象追踪都恢复
本帖最后由 ly8zx2109 于 2019-5-21 16:19 编辑
(defun c:Tt (/ e enew nv oldau oldos p s)
(setq
oldos (getvar "osmode")
oldau (getvar "autosnap")
)
(setvar "osmode" 0)
(setvar "autosnap" 0)
(princ "\n 数字递增复制")
(if (and (setq e (car (entsel "\nSelect Text: ")))
(setq e (vlax-ename->vla-object e))
(or (= "AcDbText" (vla-get-ObjectName e))
(= "AcDbMText" (vla-get-ObjectName e))
)
)
(progn
(setq s (vla-get-TextString e))
(if (null (setq nv (getreal (strcat "\nNew value:" "<1>"))))
(setq nv 1)
)
(princ "\nCopy to: ")
(while (setq p (getpoint))
(setq enew (vla-copy e))
(vla-put-textstring enew (setq s (rtos (+ (atof s) nv) 2)))
(vla-put-InsertionPoint enew (vlax-3d-point p))
)
)
(princ "\n选中的不是文本或没有选择到实体.")
)
(setvar "osmode" oldos)
(setvar "autosnap" oldau)
(setvar "cmdecho" 1)
(princ)
)
ly8zx2109 发表于 2019-5-21 15:36
(defun c:Tt (/ e enew nv oldau oldos p s)
(setq
oldos (getvar "osmode")
麻烦帮我改成能先选对象的 李青松 发表于 2019-5-21 17:39
麻烦帮我改成能先选对象的
可参考一下这个帖子。http://bbs.mjtd.com/thread-175481-1-1.html 李青松 发表于 2019-5-21 17:39
麻烦帮我改成能先选对象的
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=111868&highlight=%CF%C8%D1%A1%D4%F1%D4%D9%D6%B4%D0%D0
页:
[1]