程序意外中断如何恢复初始捕捉状态

greyzxy

(defun c:dz ()                                ;批量替换牙样式
  (vl-load-com)
  (setq myacad (vlax-get-acad-object))
  (setq mydoc (vla-get-ActiveDocument myacad))
  (setq myms (vla-get-ModelSpace mydoc))
  (setq os (getvar "osmode"))
  (setq n1 (getvar "DIMTXT"))
  (setq n2 (getvar "DIMSCALE"))
  (setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
  (setvar "cmdecho" 0)                        ;不显示普通命令的提示
  (setvar "blipmode" 0)
  (command "_.undo" "be")
  (setq n3 (* n1 n2))
  (setvar "osmode" 0)
  (setq ucs (getvar "UCSORG"))
  (setq gs 0)
  (prompt "\n选择范围: ")
  (setq ss (ssget))                        ;创建一个选择集
  (setq n (sslength ss))                ;计算出此选择集的字符
  (setq e9 (entsel "选择过滤对象: "))
  (setq tk (car e9))
  (setq e10 (vlax-ename->vla-object tk))
  (setq s1 (vla-get-ObjectName e10))        ;获取对象是块还是圆特征
  (if (= s1 "AcDbBlockReference")        ;判断是否为块
    (progn
      (setq mk1 (vla-get-EffectiveName e10))
    )
    (progn
      (if (= s1 "AcDbCircle")
        (progn
          (setq s2 (vla-get-Radius e10))
                                        ;圆的半径
          (setq s3 (vla-get-Linetype e10))
                                        ;圆的线性
          (setq s4 (vla-get-PlotStyleName e10))
                                        ;圆的线的颜色
        )
        (progn
          (alert "请选择圆或者块")
          (quit)                        ;退出运算
        )
      )
    )
  )
  (prompt "\n选择插入对象: ")
  (setq sp (ssget))
  (setq nn (sslength sp))
  (setq k 0)
  (setq kk 0)
  (while (< kk nn)
    (setq cha1 (ssname sp kk))                ;获取插入对象集中的单个元素的图元名
    (setq cha2 (vlax-ename->vla-object cha1)) ;将图元名转换成VLA对象
    (setq cc1 (vla-get-ObjectName cha2)) ;获取对象类型
    (if        (= cc1 "AcDbBlockReference")        ;判断是否为块
      (progn
        (setq cc2 (vla-get-InsertionPoint cha2))
        (setq cc3 (vlax-safearray->list (vlax-variant-value cc2)))
                                        ;圆孔坐标
        (setq x1 (car ucs))
        (setq y1 (cadr ucs))
        (setq xx2 (car cc3))
        (setq yy2 (cadr cc3))
        (setq xx (- xx2 x1))                ;X坐标值
        (setq yy (- yy2 y1))                ;圆孔的Y坐标值
        (setq cc4 '(0))
        (setq cc5 (cons YY cc4))
        (setq cc6 (cons XX cc5))
        (setq kk nn)
      )
      (progn
        (if (= cc1 "AcDbCircle")
          (progn
            (setq cc2 (vla-get-Center cha2))
            (setq cc3 (vlax-safearray->list (vlax-variant-value cc2)))
                                        ;圆孔坐标
            (setq x1 (car ucs))
            (setq y1 (cadr ucs))
            (setq xx2 (car cc3))
            (setq yy2 (cadr cc3))
            (setq xx (- xx2 x1))        ;X坐标值
            (setq yy (- yy2 y1))        ;Y坐标值
            (setq cc4 '(0))
            (setq cc5 (cons YY cc4))
            (setq cc6 (cons XX cc5))
            (setq kk nn)
          )
          (progn
            (setq kk (+ 1 kk))
            (IF        (= KK NN)
              (progn
                (setvar "osmode" 16383)
                (setq cc6 (getpoint "指定插入点："))
                (setvar "osmode" 0)
              )
            )

          )
        )
      )
    )
  )
  (while (< k N)                        ;循环语句开头
    (setq ent1 (ssname ss k))
                                        ;获取第一个选择集的图元名
    (setq sus (vlax-ename->vla-object ent1))

    (setq e3 (vla-get-ObjectName sus))
                                        ;对象的类型特征
    (if        (= e3 s1)
      (progn
        (if (= e3 "AcDbCircle")                ;判断是否为圆
          (progn
            (setq e4 (vla-get-Radius sus)) ;圆的半径
            (setq e5 (vla-get-Linetype sus))
                                        ;圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e4 s2)                ;判断是圆半径
              (progn
                (if (= e5 s3)                ;判断是圆线型
                  (progn
                    (if        (= e8 s4)        ;判断是圆颜色
                      (progn
                        (setq e1 (vla-get-Center sus))
                        (setq
                          e2 (vlax-safearray->list
                               (vlax-variant-value e1)
                             )
                        )                ;圆孔坐标
                        (setq x1 (car ucs))
                        (setq y1 (cadr ucs))
                        (setq x2 (car e2))
                        (setq y2 (cadr e2))
                        (setq x (- x2 x1)) ;圆孔的X坐标值
                        (setq y (- y2 y1)) ;圆孔的Y坐标值
                        (setq P13 '(0))
                        (setq P14 (cons Y P13))
                        (setq P15 (cons X P14)) ;圆孔坐标
                        (COMMAND "COPY" sp "" cc6 p15)
                        (entdel ent1)
                        (setq gs (+ gs 1))
                      )
                    )
                  )
                )
              )
            )
          )
          (progn
            (if        (= e3 "AcDbBlockReference")
              (progn
                (setq mk2 (vla-get-EffectiveName sus))
                (if (= mk2 mk1)
                  (progn
                    (setq e1 (vla-get-InsertionPoint sus))
                    (setq
                      e2
                       (vlax-safearray->list (vlax-variant-value e1))
                    )
                                        ;块的插入坐标
                    (setq x1 (car ucs))
                    (setq y1 (cadr ucs))
                    (setq x2 (car e2))
                    (setq y2 (cadr e2))
                    (setq x (- x2 x1))        ;块的插入的X坐标值
                    (setq y (- y2 y1))        ;块的插入的Y坐标值
                    (setq P13 '(0))
                    (setq P14 (cons Y P13))
                    (setq P15 (cons X P14)) ;块的插入坐标
                    (COMMAND "COPY" sp "" cc6 p15)
                    (entdel ent1)
                    (setq gs (+ gs 1))
                  )
                )
              )
            )
          )
        )
      )
    )
    (setq K (+ 1 K))
  )                                        ;结束循环语句
  (setq ww 0)
  (while (< ww nn)
    (setq cha1 (ssname sp ww))                ;获取插入对象集中的单个元素的图元名
    (entdel cha1)
    (setq ww (+ 1 ww))
  )
  (setvar "osmode" OS)                        ;恢复目标捕捉的原来的状态
  (setvar "blipmode" v3)                ;恢复光标痕迹原来的显示状态
  (setvar "osmode" 16383)                ;捕捉对象设置
  (setq gs1 "\n替换完成  替换:")
  (setq gs2 (rtos gs 2 2))
  (setq gs4 "个")
  (setq gs3 (strcat gs1 gs2 gs4))
  (alert gs3)
  (command "_.undo" "e")
  (setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态
)

-------------------------------------------------------------------
                                        ; (aaa '("AL2" "AL2" "AL3" "AL2" "AL1" "AL1" "AL1"));删除重复文字并排序
(defun aaa (lst / lst1)
  (foreach a lst
    (if        (not (member a lst1))
      (setq lst1 (cons a lst1))
    )
  )
  (vl-sort lst1 '<)
)
---------------------------------------------------------------------
  (defun delsame(l1 rcz / l2);;带容差去重(重复过的取第一次出现)，有时处理坐标点需要考虑容差
  (while l1
    (setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1))))
  (reverse l2))
(defun c:dx ()                                ;预定代码自动填写
  (command "_.undo" "be")
  (vl-load-com)
  (setq kbwb0 (list (list 0)))                ;创建空白表
  (setq b '(0))                                ;b是建立一个空表
  (setq b1 '(0))                        ;b1是建立一个空表
  (setq gs 0)
  (setq gs1 "添加个数:")
  (setq myacad (vlax-get-acad-object))
  (setq mydoc (vla-get-ActiveDocument myacad))
  (setq myms (vla-get-ModelSpace mydoc))
  (setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
  (setvar "cmdecho" 0)                        ;不显示普通命令的提示
  (setvar "blipmode" 0)
  (setq os (getvar "osmode"))
  (setq n1 (getvar "DIMTXT"))
  (setq n2 (getvar "DIMSCALE"))
  (setq n3 (* n1 n2))

  (setvar "osmode" 0)
  (setq ucs (getvar "UCSORG"))
  (prompt "\n选择范围: ")
  (setq ss (ssget))                        ;创建一个选择集
  (setq n (sslength ss))                ;计算出此选择集的字符
  (setq k 0)
  (while (< k N)
    (setq wz1 (ssname ss k))
    (setq wz2 (entget wz1))
    (setq wz3 (vlax-ename->vla-object wz1))
    (setq wz4 (vla-get-ObjectName wz3))
    (if        (= wz4 "AcDbMText")
      (progn
        (setq wz5 (vla-get-TextString wz3))
        (setq kbwb0 (cons wz5 kbwb0))
      )
      (progn
      )
    )
    (setq k (+ 1 k))
  )
  (setq kbwb1 (cdr (reverse kbwb0)))        ;所有文字表
  (setq kbwb2 (aaa kbwb1))


  (setq e9 (entsel "请选择一个对象: "))
  (setq tk (car e9))
  (setq e10 (vlax-ename->vla-object tk))
  (setq s1 (vla-get-ObjectName e10))
                                        ;圆特征
  (setq s2 (vla-get-Radius e10))
                                        ;圆的半径
  (setq s3 (vla-get-Linetype e10))
                                        ;圆的线性
  (setq s4 (vla-get-PlotStyleName e10))
                                        ;圆的线的颜色
  (setq sp (getstring "\n请确认输入的代码:"))
  (setq k 0)
  (setq wn (length kbwb2))
  (while (< k wn)
    (setq kbwb3 (nth k kbwb2))
    (if        (= kbwb3 sp)
      (progn

        (initget 1 "Yes No")
        (setq x (getkword "代码重复是否继续使用此代码[是(Y)/否(N)]： "))
        (if (= x "Yes")
          (progn
            (setq k wn)
          )
          (progn
            (setq sp (getstring "\n请重新输入的代码:"))
            (setq k 0)
          )
        )

      )
      (progn
      )
    )
    (setq k (+ 1 k))
  )





  (setq jj (getstring "\n请输入颜色数值[读取对象(S)："))
  (if (= jj "S")
    (progn
      (setq ee (entsel "\n颜色读取对象: "))
      (setq ee1 (car ee))
      (setq ee2 (entget ee1))
      (setq ee3 (assoc 62 ee2))
      (setq ee4 (cdr ee3))
      (setq s (strcase sp))                ;小写变成大写
      (setq k 0)
      (while (< k N)                        ;循环语句开头
        (setq ent1 (ssname ss k))
        (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
        (setq sus (vlax-ename->vla-object ent1))

        (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
        (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
        (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
        (if (= e3 s1)                        ;判断是否为圆
          (progn
            (setq e4 (vla-get-Radius sus)) ;圆的半径
            (if        (= e4 s2)                ;判断是圆半径
              (progn
                (if (= e5 s3)                ;判断是圆线型
                  (progn
                    (if        (= e8 s4)        ;判断是圆颜色
                      (progn
                        (setq e1 (vla-get-Center sus))
                        (setq
                          e2
                           (vlax-safearray->list (vlax-variant-value e1))
                        )                ;圆孔坐标
                        (setq x1 (car ucs))
                        (setq y1 (cadr ucs))
                        (setq x2 (car e2))
                        (setq y2 (cadr e2))
                        (setq x (- x2 x1)) ;圆孔的X坐标值
                        (setq y (- y2 y1)) ;圆孔的Y坐标值
                        (setq e6 (vla-get-Radius sus)) ;获取圆孔直径
                        (command "chprop" ent1 "" "C" ee4 "")
                        (setq e7 (+ 3 E6))
                        (setq P13 '(0))
                        (setq P14 (cons Y P13))
                        (setq P15 (cons X P14))
                        (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                        (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                        (setq gs (+ gs 1))
                      )
                    )
                  )
                )
              )
            )
          )
        )
        (setq K (+ 1 K))
      )                                        ;结束循环语句
    )
    (progn
      (if (= jj "s")
        (progn
          (setq ee (entsel "\n颜色读取对象: "))
          (setq ee1 (car ee))
          (setq ee2 (entget ee1))
          (setq ee3 (assoc 62 ee2))
          (setq ee4 (cdr ee3))
          (setq s (strcase sp))                ;小写变成大写
          (setq k 0)
          (while (< k N)                ;循环语句开头
            (setq ent1 (ssname ss k))
            (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
            (setq sus (vlax-ename->vla-object ent1))

            (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
            (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e3 s1)                ;判断是否为圆
              (progn
                (setq e4 (vla-get-Radius sus)) ;圆的半径
                (if (= e4 s2)                ;判断是圆半径
                  (progn
                    (if        (= e5 s3)        ;判断是圆线型
                      (progn
                        (if (= e8 s4)        ;判断是圆颜色
                          (progn
                            (setq e1 (vla-get-Center sus))
                            (setq
                              e2
                               (vlax-safearray->list
                                 (vlax-variant-value e1)
                               )
                            )                ;圆孔坐标
                            (setq x1 (car ucs))
                            (setq y1 (cadr ucs))
                            (setq x2 (car e2))
                            (setq y2 (cadr e2))
                            (setq x (- x2 x1)) ;圆孔的X坐标值
                            (setq y (- y2 y1)) ;圆孔的Y坐标值
                            (setq e6 (vla-get-Radius sus))
                                        ;获取圆孔直径
                            (command "chprop" ent1 "" "C" ee4 "")
                            (setq e7 (+ 3 E6))
                            (setq P13 '(0))
                            (setq P14 (cons Y P13))
                            (setq P15 (cons X P14))
                            (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                            (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                            (setq gs (+ gs 1))
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq K (+ 1 K))
          )

        )
        (progn
          (setq s (strcase sp))                ;小写变成大写
          (setq k 0)
          (while (< k N)                ;循环语句开头
            (setq ent1 (ssname ss k))
            (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
            (setq sus (vlax-ename->vla-object ent1))

            (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
            (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e3 s1)                ;判断是否为圆
              (progn
                (setq e4 (vla-get-Radius sus)) ;圆的半径
                (if (= e4 s2)                ;判断是圆半径
                  (progn
                    (if        (= e5 s3)        ;判断是圆线型
                      (progn
                        (if (= e8 s4)        ;判断是圆颜色
                          (progn
                            (setq e1 (vla-get-Center sus))
                            (setq
                              e2
                               (vlax-safearray->list
                                 (vlax-variant-value e1)
                               )
                            )                ;圆孔坐标
                            (setq x1 (car ucs))
                            (setq y1 (cadr ucs))
                            (setq x2 (car e2))
                            (setq y2 (cadr e2))
                            (setq x (- x2 x1)) ;圆孔的X坐标值
                            (setq y (- y2 y1)) ;圆孔的Y坐标值
                            (setq e6 (vla-get-Radius sus))
                                        ;获取圆孔直径
                            (command "chprop" ent1 "" "C" jj "")
                            (setq e7 (+ 3 E6))
                            (setq P13 '(0))
                            (setq P14 (cons Y P13))
                            (setq P15 (cons X P14))
                            (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                            (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                            (setq gs (+ gs 1))
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq K (+ 1 K))
          )
        )
      )
    )
  )

                                        ;(setq b (cdr (reverse b)))
  (setq k 0)
  (setq b (vl-remove 0 b));去除表里面的0元素
(setq b1 (delsame b 0.0001));调用子函数DELSAME删除重复元素
  (setq k 0)
  (setq n (length b1))
  (while (< k n)                        ;n是表元素的数目
    (setq P12 (nth K b1))
    (COMMAND "MTEXT" P12 "H" n3 P12 S "")
    (setq K (+ 1 K))
  )
  (setvar "osmode" OS)                        ;恢复目标捕捉的原来的状态
  (setvar "blipmode" v3)                ;恢复光标痕迹原来的显示状态
  (setvar "osmode" 16383)                ;捕捉对象设置
  (setvar "osmode" 16383)
  (setq gs4 (- gs n))                        ;重复的个数
  (setq gs4 (rtos gs4 2 2))
  (setq n (rtos n 2 2))
  (setq gs5 "已删除重复文字：")
  (setq gs3 (strcat gs1 n gs5 gs4))
  (alert gs3)
  (command "_.undo" "E")
  (setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态显示状态

)
---------------------------------
(defun c:NN ()                                ;计算相同的文字在选定范围内有多少个！
  (vl-load-com)
(setq myacad (vlax-get-acad-object))
(setq mydoc (vla-get-ActiveDocument myacad))
(setq myms (vla-get-ModelSpace mydoc))
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
(setvar "osmode" 0)
(setq ucs (getvar "UCSORG"))
(setq n1 (getvar "DIMTXT"))
(setq n2 (getvar "DIMSCALE"))
(setq n3 (* n1 n2))
(prompt "\n选择范围: ")
(setq ss (ssget '((0 . "MTEXT"))))        ;获取选取范围内的文字
(setq n (sslength ss))
(setq NN1 (entsel "\n请选择一个参考对象: "))
(setq NN2 (car NN1))
(setq NN3 (entget NN2))
(setq NN4 (assoc '1 NN3))
(setq NN5 (cdr NN4))                        ;获取文字
(setq NN6 (assoc '0 NN3))
(setq NN7 (cdr NN6))                        ;获取文字类型
(if (= NN7 "MTEXT")
  (progn
  )
  (progn
    (setq r3 "你选择的不是文字")
    (alert r3)
    (prin1)
    (quit)
  )
)
(setq BZ (entsel "\n请选择侧面标注: "))
(setq BZ1 (car BZ))
(setq BZ2 (vlax-ename->vla-object BZ1))        ;图元名转换为VLA对象
(setq KS (vla-get-ObjectName BZ2))
(if (= KS "AcDbMText")
  (progn
    (setq m1 (vla-get-TextString BZ2))
  )
  (progn
    (setq m1 (vla-get-TextOverride BZ2))
  )
)
(if (= m1 "")
  (progn
    (setq r4 "数据前面Ф或M")
    (alert r4)
    (prin1)
    (quit)
  )
  (progn
  )
)
(setq p (getpoint "\n选取代码放置位置："))
(setq k 0)
(setq TJ 0)
(while (< k n)
  (setq ent1 (ssname ss k))
  (setq ent2 (entget ent1))
  (setq ent3 (assoc '1 ent2))
  (setq ent4 (cdr ent3))                ;获取文字
  (if (= NN5 ent4)
    (progn
      (setq TJ (+ TJ 1))
      (setq ent2 (subst (cons 62 1) (assoc 62 ent2) ent2))
      (entmod ent2)
    )
    (progn
    )
  )
  (setq K (+ 1 K))
)

(COMMAND "MTEXT" p "h" n3 p NN5 "")
(setq TJ1 (rtos TJ 2 2))
(setq e8 (strcat TJ1 "-" m1))
(setq TJ2 (strcat TJ1 "X"))
(setq mzls (vl-string-search "2X" M1)) ;判断字符串里面有没有“2X”
(if (= KS "AcDbMText")
  (progn
    (if        (= MZLS nil)
      (progn
        (vlax-put-property BZ2 'TextString e8)
      )
      (progn
        (setq e8 (vl-string-subst TJ2 "2X" M1));寻找字符串里面的“2”替换成计算个数
        (vlax-put-property BZ2 'TextString e8)
      )
    )
  )
  (progn
(if        (= MZLS nil)
(progn
(command "DIMEDIT" "n" e8 BZ "")
)
(progn       
(setq e8 (vl-string-subst TJ2 "2X" M1));寻找字符串里面的“2”替换成计算个数
(command "DIMEDIT" "n" e8 BZ "")
)
)   
  )
)
(setvar "osmode" v1)                        ;恢复目标捕捉的原来的状态
(setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态
(setvar "blipmode" v3)                        ;恢复光标痕迹原来的显示状态
(setvar "osmode" 16383)
)


以上插件有三个功能,替换图,放代码,统计代码数量.执行命令时程序会关闭捕捉,按ESC中断操作,捕捉状态不能还原.我是小白,不知道怎么修改代码,求大神帮忙修改一下,使中断操作时捕捉状态能够还原,谢谢

wudechao

(defun c:dz (/ *error*)                                ;批量替换牙样式
  (vl-load-com)
(defun *error* (msg)
    (if OS
      (setvar "osmode" OS)
    )
    (setvar "cmdecho" 1)
  )
  (setq myacad (vlax-get-acad-object))
  (setq mydoc (vla-get-ActiveDocument myacad))
  (setq myms (vla-get-ModelSpace mydoc))
  (setq os (getvar "osmode"))
  (setq n1 (getvar "DIMTXT"))
  (setq n2 (getvar "DIMSCALE"))
  (setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
  (setvar "cmdecho" 0)                        ;不显示普通命令的提示
  (setvar "blipmode" 0)
  (command "_.undo" "be")
  (setq n3 (* n1 n2))
  (setvar "osmode" 0)
  (setq ucs (getvar "UCSORG"))
  (setq gs 0)
  (prompt "\n选择范围: ")
  (setq ss (ssget))                        ;创建一个选择集
  (setq n (sslength ss))                ;计算出此选择集的字符
  (setq e9 (entsel "选择过滤对象: "))
  (setq tk (car e9))
  (setq e10 (vlax-ename->vla-object tk))
  (setq s1 (vla-get-ObjectName e10))        ;获取对象是块还是圆特征
  (if (= s1 "AcDbBlockReference")        ;判断是否为块
    (progn
      (setq mk1 (vla-get-EffectiveName e10))
    )
    (progn
      (if (= s1 "AcDbCircle")
        (progn
          (setq s2 (vla-get-Radius e10))
                                        ;圆的半径
          (setq s3 (vla-get-Linetype e10))
                                        ;圆的线性
          (setq s4 (vla-get-PlotStyleName e10))
                                        ;圆的线的颜色
        )
        (progn
          (alert "请选择圆或者块")
          (quit)                        ;退出运算
        )
      )
    )
  )
  (prompt "\n选择插入对象: ")
  (setq sp (ssget))
  (setq nn (sslength sp))
  (setq k 0)
  (setq kk 0)
  (while (< kk nn)
    (setq cha1 (ssname sp kk))                ;获取插入对象集中的单个元素的图元名
    (setq cha2 (vlax-ename->vla-object cha1)) ;将图元名转换成VLA对象
    (setq cc1 (vla-get-ObjectName cha2)) ;获取对象类型
    (if        (= cc1 "AcDbBlockReference")        ;判断是否为块
      (progn
        (setq cc2 (vla-get-InsertionPoint cha2))
        (setq cc3 (vlax-safearray->list (vlax-variant-value cc2)))
                                        ;圆孔坐标
        (setq x1 (car ucs))
        (setq y1 (cadr ucs))
        (setq xx2 (car cc3))
        (setq yy2 (cadr cc3))
        (setq xx (- xx2 x1))                ;X坐标值
        (setq yy (- yy2 y1))                ;圆孔的Y坐标值
        (setq cc4 '(0))
        (setq cc5 (cons YY cc4))
        (setq cc6 (cons XX cc5))
        (setq kk nn)
      )
      (progn
        (if (= cc1 "AcDbCircle")
          (progn
            (setq cc2 (vla-get-Center cha2))
            (setq cc3 (vlax-safearray->list (vlax-variant-value cc2)))
                                        ;圆孔坐标
            (setq x1 (car ucs))
            (setq y1 (cadr ucs))
            (setq xx2 (car cc3))
            (setq yy2 (cadr cc3))
            (setq xx (- xx2 x1))        ;X坐标值
            (setq yy (- yy2 y1))        ;Y坐标值
            (setq cc4 '(0))
            (setq cc5 (cons YY cc4))
            (setq cc6 (cons XX cc5))
            (setq kk nn)
          )
          (progn
            (setq kk (+ 1 kk))
            (IF        (= KK NN)
              (progn
                (setvar "osmode" 16383)
                (setq cc6 (getpoint "指定插入点："))
                (setvar "osmode" 0)
              )
            )

          )
        )
      )
    )
  )
  (while (< k N)                        ;循环语句开头
    (setq ent1 (ssname ss k))
                                        ;获取第一个选择集的图元名
    (setq sus (vlax-ename->vla-object ent1))

    (setq e3 (vla-get-ObjectName sus))
                                        ;对象的类型特征
    (if        (= e3 s1)
      (progn
        (if (= e3 "AcDbCircle")                ;判断是否为圆
          (progn
            (setq e4 (vla-get-Radius sus)) ;圆的半径
            (setq e5 (vla-get-Linetype sus))
                                        ;圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e4 s2)                ;判断是圆半径
              (progn
                (if (= e5 s3)                ;判断是圆线型
                  (progn
                    (if        (= e8 s4)        ;判断是圆颜色
                      (progn
                        (setq e1 (vla-get-Center sus))
                        (setq
                          e2 (vlax-safearray->list
                               (vlax-variant-value e1)
                             )
                        )                ;圆孔坐标
                        (setq x1 (car ucs))
                        (setq y1 (cadr ucs))
                        (setq x2 (car e2))
                        (setq y2 (cadr e2))
                        (setq x (- x2 x1)) ;圆孔的X坐标值
                        (setq y (- y2 y1)) ;圆孔的Y坐标值
                        (setq P13 '(0))
                        (setq P14 (cons Y P13))
                        (setq P15 (cons X P14)) ;圆孔坐标
                        (COMMAND "COPY" sp "" cc6 p15)
                        (entdel ent1)
                        (setq gs (+ gs 1))
                      )
                    )
                  )
                )
              )
            )
          )
          (progn
            (if        (= e3 "AcDbBlockReference")
              (progn
                (setq mk2 (vla-get-EffectiveName sus))
                (if (= mk2 mk1)
                  (progn
                    (setq e1 (vla-get-InsertionPoint sus))
                    (setq
                      e2
                       (vlax-safearray->list (vlax-variant-value e1))
                    )
                                        ;块的插入坐标
                    (setq x1 (car ucs))
                    (setq y1 (cadr ucs))
                    (setq x2 (car e2))
                    (setq y2 (cadr e2))
                    (setq x (- x2 x1))        ;块的插入的X坐标值
                    (setq y (- y2 y1))        ;块的插入的Y坐标值
                    (setq P13 '(0))
                    (setq P14 (cons Y P13))
                    (setq P15 (cons X P14)) ;块的插入坐标
                    (COMMAND "COPY" sp "" cc6 p15)
                    (entdel ent1)
                    (setq gs (+ gs 1))
                  )
                )
              )
            )
          )
        )
      )
    )
    (setq K (+ 1 K))
  )                                        ;结束循环语句
  (setq ww 0)
  (while (< ww nn)
    (setq cha1 (ssname sp ww))                ;获取插入对象集中的单个元素的图元名
    (entdel cha1)
    (setq ww (+ 1 ww))
  )
  (setvar "osmode" OS)                        ;恢复目标捕捉的原来的状态
  (setvar "blipmode" v3)                ;恢复光标痕迹原来的显示状态
  (setvar "osmode" 16383)                ;捕捉对象设置
  (setq gs1 "\n替换完成  替换:")
  (setq gs2 (rtos gs 2 2))
  (setq gs4 "个")
  (setq gs3 (strcat gs1 gs2 gs4))
  (alert gs3)
  (command "_.undo" "e")
  (setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态
)

-------------------------------------------------------------------
                                        ; (aaa '("AL2" "AL2" "AL3" "AL2" "AL1" "AL1" "AL1"));删除重复文字并排序
(defun aaa (lst / lst1)
  (foreach a lst
    (if        (not (member a lst1))
      (setq lst1 (cons a lst1))
    )
  )
  (vl-sort lst1 '<)
)
---------------------------------------------------------------------
  (defun delsame(l1 rcz / l2);;带容差去重(重复过的取第一次出现)，有时处理坐标点需要考虑容差
  (while l1
    (setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1))))
  (reverse l2))
(defun c:dx (/ *error*)                                ;预定代码自动填写
  (command "_.undo" "be")
  (vl-load-com)
(defun *error* (msg)
    (if OS
      (setvar "osmode" OS)
    )
    (setvar "cmdecho" 1)
  )
  (setq kbwb0 (list (list 0)))                ;创建空白表
  (setq b '(0))                                ;b是建立一个空表
  (setq b1 '(0))                        ;b1是建立一个空表
  (setq gs 0)
  (setq gs1 "添加个数:")
  (setq myacad (vlax-get-acad-object))
  (setq mydoc (vla-get-ActiveDocument myacad))
  (setq myms (vla-get-ModelSpace mydoc))
  (setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
  (setvar "cmdecho" 0)                        ;不显示普通命令的提示
  (setvar "blipmode" 0)
  (setq os (getvar "osmode"))
  (setq n1 (getvar "DIMTXT"))
  (setq n2 (getvar "DIMSCALE"))
  (setq n3 (* n1 n2))

  (setvar "osmode" 0)
  (setq ucs (getvar "UCSORG"))
  (prompt "\n选择范围: ")
  (setq ss (ssget))                        ;创建一个选择集
  (setq n (sslength ss))                ;计算出此选择集的字符
  (setq k 0)
  (while (< k N)
    (setq wz1 (ssname ss k))
    (setq wz2 (entget wz1))
    (setq wz3 (vlax-ename->vla-object wz1))
    (setq wz4 (vla-get-ObjectName wz3))
    (if        (= wz4 "AcDbMText")
      (progn
        (setq wz5 (vla-get-TextString wz3))
        (setq kbwb0 (cons wz5 kbwb0))
      )
      (progn
      )
    )
    (setq k (+ 1 k))
  )
  (setq kbwb1 (cdr (reverse kbwb0)))        ;所有文字表
  (setq kbwb2 (aaa kbwb1))


  (setq e9 (entsel "请选择一个对象: "))
  (setq tk (car e9))
  (setq e10 (vlax-ename->vla-object tk))
  (setq s1 (vla-get-ObjectName e10))
                                        ;圆特征
  (setq s2 (vla-get-Radius e10))
                                        ;圆的半径
  (setq s3 (vla-get-Linetype e10))
                                        ;圆的线性
  (setq s4 (vla-get-PlotStyleName e10))
                                        ;圆的线的颜色
  (setq sp (getstring "\n请确认输入的代码:"))
  (setq k 0)
  (setq wn (length kbwb2))
  (while (< k wn)
    (setq kbwb3 (nth k kbwb2))
    (if        (= kbwb3 sp)
      (progn

        (initget 1 "Yes No")
        (setq x (getkword "代码重复是否继续使用此代码[是(Y)/否(N)]： "))
        (if (= x "Yes")
          (progn
            (setq k wn)
          )
          (progn
            (setq sp (getstring "\n请重新输入的代码:"))
            (setq k 0)
          )
        )

      )
      (progn
      )
    )
    (setq k (+ 1 k))
  )





  (setq jj (getstring "\n请输入颜色数值[读取对象(S)："))
  (if (= jj "S")
    (progn
      (setq ee (entsel "\n颜色读取对象: "))
      (setq ee1 (car ee))
      (setq ee2 (entget ee1))
      (setq ee3 (assoc 62 ee2))
      (setq ee4 (cdr ee3))
      (setq s (strcase sp))                ;小写变成大写
      (setq k 0)
      (while (< k N)                        ;循环语句开头
        (setq ent1 (ssname ss k))
        (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
        (setq sus (vlax-ename->vla-object ent1))

        (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
        (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
        (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
        (if (= e3 s1)                        ;判断是否为圆
          (progn
            (setq e4 (vla-get-Radius sus)) ;圆的半径
            (if        (= e4 s2)                ;判断是圆半径
              (progn
                (if (= e5 s3)                ;判断是圆线型
                  (progn
                    (if        (= e8 s4)        ;判断是圆颜色
                      (progn
                        (setq e1 (vla-get-Center sus))
                        (setq
                          e2
                           (vlax-safearray->list (vlax-variant-value e1))
                        )                ;圆孔坐标
                        (setq x1 (car ucs))
                        (setq y1 (cadr ucs))
                        (setq x2 (car e2))
                        (setq y2 (cadr e2))
                        (setq x (- x2 x1)) ;圆孔的X坐标值
                        (setq y (- y2 y1)) ;圆孔的Y坐标值
                        (setq e6 (vla-get-Radius sus)) ;获取圆孔直径
                        (command "chprop" ent1 "" "C" ee4 "")
                        (setq e7 (+ 3 E6))
                        (setq P13 '(0))
                        (setq P14 (cons Y P13))
                        (setq P15 (cons X P14))
                        (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                        (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                        (setq gs (+ gs 1))
                      )
                    )
                  )
                )
              )
            )
          )
        )
        (setq K (+ 1 K))
      )                                        ;结束循环语句
    )
    (progn
      (if (= jj "s")
        (progn
          (setq ee (entsel "\n颜色读取对象: "))
          (setq ee1 (car ee))
          (setq ee2 (entget ee1))
          (setq ee3 (assoc 62 ee2))
          (setq ee4 (cdr ee3))
          (setq s (strcase sp))                ;小写变成大写
          (setq k 0)
          (while (< k N)                ;循环语句开头
            (setq ent1 (ssname ss k))
            (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
            (setq sus (vlax-ename->vla-object ent1))

            (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
            (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e3 s1)                ;判断是否为圆
              (progn
                (setq e4 (vla-get-Radius sus)) ;圆的半径
                (if (= e4 s2)                ;判断是圆半径
                  (progn
                    (if        (= e5 s3)        ;判断是圆线型
                      (progn
                        (if (= e8 s4)        ;判断是圆颜色
                          (progn
                            (setq e1 (vla-get-Center sus))
                            (setq
                              e2
                               (vlax-safearray->list
                                 (vlax-variant-value e1)
                               )
                            )                ;圆孔坐标
                            (setq x1 (car ucs))
                            (setq y1 (cadr ucs))
                            (setq x2 (car e2))
                            (setq y2 (cadr e2))
                            (setq x (- x2 x1)) ;圆孔的X坐标值
                            (setq y (- y2 y1)) ;圆孔的Y坐标值
                            (setq e6 (vla-get-Radius sus))
                                        ;获取圆孔直径
                            (command "chprop" ent1 "" "C" ee4 "")
                            (setq e7 (+ 3 E6))
                            (setq P13 '(0))
                            (setq P14 (cons Y P13))
                            (setq P15 (cons X P14))
                            (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                            (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                            (setq gs (+ gs 1))
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq K (+ 1 K))
          )

        )
        (progn
          (setq s (strcase sp))                ;小写变成大写
          (setq k 0)
          (while (< k N)                ;循环语句开头
            (setq ent1 (ssname ss k))
            (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
            (setq sus (vlax-ename->vla-object ent1))

            (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
            (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e3 s1)                ;判断是否为圆
              (progn
                (setq e4 (vla-get-Radius sus)) ;圆的半径
                (if (= e4 s2)                ;判断是圆半径
                  (progn
                    (if        (= e5 s3)        ;判断是圆线型
                      (progn
                        (if (= e8 s4)        ;判断是圆颜色
                          (progn
                            (setq e1 (vla-get-Center sus))
                            (setq
                              e2
                               (vlax-safearray->list
                                 (vlax-variant-value e1)
                               )
                            )                ;圆孔坐标
                            (setq x1 (car ucs))
                            (setq y1 (cadr ucs))
                            (setq x2 (car e2))
                            (setq y2 (cadr e2))
                            (setq x (- x2 x1)) ;圆孔的X坐标值
                            (setq y (- y2 y1)) ;圆孔的Y坐标值
                            (setq e6 (vla-get-Radius sus))
                                        ;获取圆孔直径
                            (command "chprop" ent1 "" "C" jj "")
                            (setq e7 (+ 3 E6))
                            (setq P13 '(0))
                            (setq P14 (cons Y P13))
                            (setq P15 (cons X P14))
                            (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                            (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                            (setq gs (+ gs 1))
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq K (+ 1 K))
          )
        )
      )
    )
  )

                                        ;(setq b (cdr (reverse b)))
  (setq k 0)
  (setq b (vl-remove 0 b));去除表里面的0元素
(setq b1 (delsame b 0.0001));调用子函数DELSAME删除重复元素
  (setq k 0)
  (setq n (length b1))
  (while (< k n)                        ;n是表元素的数目
    (setq P12 (nth K b1))
    (COMMAND "MTEXT" P12 "H" n3 P12 S "")
    (setq K (+ 1 K))
  )
  (setvar "osmode" OS)                        ;恢复目标捕捉的原来的状态
  (setvar "blipmode" v3)                ;恢复光标痕迹原来的显示状态
  (setvar "osmode" 16383)                ;捕捉对象设置
  (setvar "osmode" 16383)
  (setq gs4 (- gs n))                        ;重复的个数
  (setq gs4 (rtos gs4 2 2))
  (setq n (rtos n 2 2))
  (setq gs5 "已删除重复文字：")
  (setq gs3 (strcat gs1 n gs5 gs4))
  (alert gs3)
  (command "_.undo" "E")
  (setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态显示状态

)
---------------------------------
(defun c:NN (/ *error*)                                ;计算相同的文字在选定范围内有多少个！
  (vl-load-com)
(defun *error* (msg)
    (if OS
      (setvar "osmode" OS)
    )
    (setvar "cmdecho" 1)
  )
(setq myacad (vlax-get-acad-object))
(setq mydoc (vla-get-ActiveDocument myacad))
(setq myms (vla-get-ModelSpace mydoc))
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
(setvar "osmode" 0)
(setq ucs (getvar "UCSORG"))
(setq n1 (getvar "DIMTXT"))
(setq n2 (getvar "DIMSCALE"))
(setq n3 (* n1 n2))
(prompt "\n选择范围: ")
(setq ss (ssget '((0 . "MTEXT"))))        ;获取选取范围内的文字
(setq n (sslength ss))
(setq NN1 (entsel "\n请选择一个参考对象: "))
(setq NN2 (car NN1))
(setq NN3 (entget NN2))
(setq NN4 (assoc '1 NN3))
(setq NN5 (cdr NN4))                        ;获取文字
(setq NN6 (assoc '0 NN3))
(setq NN7 (cdr NN6))                        ;获取文字类型
(if (= NN7 "MTEXT")
  (progn
  )
  (progn
    (setq r3 "你选择的不是文字")
    (alert r3)
    (prin1)
    (quit)
  )
)
(setq BZ (entsel "\n请选择侧面标注: "))
(setq BZ1 (car BZ))
(setq BZ2 (vlax-ename->vla-object BZ1))        ;图元名转换为VLA对象
(setq KS (vla-get-ObjectName BZ2))
(if (= KS "AcDbMText")
  (progn
    (setq m1 (vla-get-TextString BZ2))
  )
  (progn
    (setq m1 (vla-get-TextOverride BZ2))
  )
)
(if (= m1 "")
  (progn
    (setq r4 "数据前面Ф或M")
    (alert r4)
    (prin1)
    (quit)
  )
  (progn
  )
)
(setq p (getpoint "\n选取代码放置位置："))
(setq k 0)
(setq TJ 0)
(while (< k n)
  (setq ent1 (ssname ss k))
  (setq ent2 (entget ent1))
  (setq ent3 (assoc '1 ent2))
  (setq ent4 (cdr ent3))                ;获取文字
  (if (= NN5 ent4)
    (progn
      (setq TJ (+ TJ 1))
      (setq ent2 (subst (cons 62 1) (assoc 62 ent2) ent2))
      (entmod ent2)
    )
    (progn
    )
  )
  (setq K (+ 1 K))
)

(COMMAND "MTEXT" p "h" n3 p NN5 "")
(setq TJ1 (rtos TJ 2 2))
(setq e8 (strcat TJ1 "-" m1))
(setq TJ2 (strcat TJ1 "X"))
(setq mzls (vl-string-search "2X" M1)) ;判断字符串里面有没有“2X”
(if (= KS "AcDbMText")
  (progn
    (if        (= MZLS nil)
      (progn
        (vlax-put-property BZ2 'TextString e8)
      )
      (progn
        (setq e8 (vl-string-subst TJ2 "2X" M1));寻找字符串里面的“2”替换成计算个数
        (vlax-put-property BZ2 'TextString e8)
      )
    )
  )
  (progn
(if        (= MZLS nil)
(progn
(command "DIMEDIT" "n" e8 BZ "")
)
(progn        
(setq e8 (vl-string-subst TJ2 "2X" M1));寻找字符串里面的“2”替换成计算个数
(command "DIMEDIT" "n" e8 BZ "")
)
)   
  )
)
(setvar "osmode" v1)                        ;恢复目标捕捉的原来的状态
(setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态
(setvar "blipmode" v3)                        ;恢复光标痕迹原来的显示状态
(setvar "osmode" 16383)
)

Andyhon

...按ESC中断操作...
这不是个好的操作习惯...
能改掉最好
~~~~~~~~~~~~~~~~~
自用的话 其实有个偏方

另做一个按钮 or 自定义一个快捷键
用来设定常用的捕捉模式

遇上了就执行...

------------

每拿到一个程序就去修改代码挺累人滴...

在整体规划环境 常态是带入(函式)去处理
而不是每一个程序都去写专属的错误函式
(见院长的范例)
~~~~~~~~~~~~~~~~~~

写专属的错误函式 ==> 见官方范例

3darray.Lsp
3d.Lsp
edge.Lsp
...

tryhi

不知道哪位老师教要去设置捕捉变量，感觉没有任何情况需要去设置，就算是command，用non就行，设置变量太流氓，另外设置为0更是流氓中的流氓，就不能模拟F3直接加上16384吗，好好的非得变量搞成0，严重鄙视

wudechao

增加一个*error*变量
定义 *error*，在前面增加以下代码就可以。
  (defun *error* (msg)
        (if os
          (setvar "osmode" os)
        )
        (setvar "cmdecho" 1)
  ); _结束error

greyzxy

wudechao 发表于 2019-5-8 22:26
(defun c:dz (/ *error*)                                ;批量替换牙样式
  (vl-load-com)
(defun *e ...

这样确实有效,非常感谢

20060510412

greyzxy 发表于 2019-5-9 08:31
这样确实有效,非常感谢

没看懂，是直接把这个子程序放到源代码里面就可以了吗？其他地方怎么引用这个子程序呢