改成程序启动后对象捕捉，对象追踪都关闭，程序结束后对象捕捉，对象追踪都恢复

李青松

(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

(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")

麻烦帮我改成能先选对象的

ly8zx2109

李青松 发表于 2019-5-21 17:39
麻烦帮我改成能先选对象的

可参考一下这个帖子。http://bbs.mjtd.com/thread-175481-1-1.html

ly8zx2109

李青松 发表于 2019-5-21 17:39
麻烦帮我改成能先选对象的

http://bbs.mjtd.com/forum.php?mo ... 1%D4%D9%D6%B4%D0%D0