Lisp插件在WIN10系统下不能运行的问题

cocoorange

这是一个标注节点桩号的程序，这个程序在WIN7系统下是正常的，但是WIN10系统下运行到一半就退出来了，请坛里的大神帮我看看是怎么回事吧，小弟在此先谢谢了

具体问题是这样的，运行JJ命令，在多段线上选区第一个点，输入第一个点的桩号，比如1000，然后选第二个点，输入第二个点的桩号，比如1200，然后再随便找一个点就可以标出这个点的桩号。现在WIN10系统下输入第二个点的桩号就退出了。

;;;标注节点桩号.by cocoorange 17.04.16
;;;--------------------------------------------------

;;小数点后数字加1
;strlen 以整数形式返回一个字符串中字符的个数
;atoi 将一个字符串转换成整数
;entmod 修改对象（图元）的定义数据
;itoa 将整数转换成字符串，并返回转换结果
;strcat 将多个字符串拼接成一个长字符串后返回
;subst 在表中搜索某旧项，并将表中出现的每一个旧项用新项代替，然后返回修改后所得的表
;substr返回字符串中的一个子字符串

;定义出错处理函数trap1
  (defun trap1 (errmsg)                 ;
    (setvar "osmode" 4143)  ;捕捉设置,出错之后重设捕捉
    (setvar "CMDECHO" 1)            ;打开回显
    (setq *error* temperr)
  )     ;错误处理函数
;;jj程序主体
(defun C:jj()
  (setq cmd_old (getvar "CMDECHO")) ;获取原始回显值
  (setq os_old (getvar "osmode")) ;获取原始捕捉值
  
  (setvar "CMDECHO" 0)          ;关闭回显
  
  (setq temperr *error*)
  (setq *error* trap1)
  
  (vl-load-com)
  (setvar "osmode" 0)
  (vl-cmdf "UCS" "")                            ;切换世界坐标系
  (setq el (car (entsel "\n选择桩号线:")))                ;entsel通过一个点选择一个图元，返回图元名称el
  (setvar "osmode" 4143)
  (setq ep1 (getpoint "\n选择桩号基准点1:"))              ;选择桩号基点
  (setq k1 (getreal "\n输入基点1桩号值:"))                ;输入基点桩号值
  (setq ep2 (getpoint "\n选择桩号基准点2:"))
  (setq k2 (getreal "\n输入基点2桩号值:"))
  (setvar "osmode" 0)
  (setq 1ep1 (vlax-curve-getClosestPointTo el ep1 nil))   ;
  (setq ep1dist1 (vlax-curve-getDistAtPoint el 1ep1))     ;
  (setq 2ep2 (vlax-curve-getClosestPointTo el ep2 nil))   ;
  (setq ep2dist2 (vlax-curve-getDistAtPoint el 2ep2))     ;
  (if (> (* (- k1 k2) (- ep1dist1 ep2dist2)) 0)           ;判断曲线方向与桩号方向是否一致
      (setq dpnum1 1.0)
      (setq dpnum1 -1.0)
  )  
  (prompt "\n正负判断结果dpnum1:")
  (prin1 dpnum1)

;设置通用常量
  (setq name1 (getvar "users1"))
  (setq txth1 (getvar "userr1"))
  (setq kname1 (getvar "users2"))
  (setq kacc1 (getvar "useri1"))
  (while   
    (progn
      (prompt "\n[节点名称(N)<")
      (prin1 name1)
      (prompt ">/文字高度(H)<")
      (prin1 txth1)
      (prompt ">/桩号前缀(Z)<")
      (prin1 kname1)
      (prompt ">/桩号精度(A)<")
      (prin1 kacc1)
      (prompt ">]:")
      (setq op1 (getstring)) ;输入选项
      (/= op1 "")
    )   
    (cond
      ((= op1 "n")
       (if (/= (setq name2 (getstring "\n输入节点名称:")) nil)
         (setq name1 name2)
       )
      )
      ((= op1 "h")
       (if (/= (setq txth2 (getreal "\n输入文字高度:")) nil)
         (setq txth1 txth2)
       )
      )
      ((= op1 "z")
       (if (/= (setq kname2 (getstring "\n输入桩号前缀:")) nil)
         (setq kname1 kname2)
       )
      )
      ((= op1 "a")
       (if (/= (setq kacc2 (getint "\n输入桩号精度:")) nil)
         (setq kacc1 kacc2)
       )
      )
      (T nil)
    )
  )
  (setvar "users1" name1)
  (setvar "userr1" txth1)
  (setvar "users2" kname1)
  (setvar "useri1" kacc1)
  
  ;循环标注节点
  (while                                             ;
    (progn
      (setvar "osmode" 4143)
      (setq dp1 (getpoint "\n选择节点定位点:"))              ;选择节点定位点
      (/= dp1 nil)
    )
    (setvar "osmode" 0)
    (setq 1dp1 (vlax-curve-getClosestPointTo el dp1 t))   ;节点与桩号线最近点
    (setq dp1dist1 (vlax-curve-getDistAtPoint el 1dp1))
        
    (princ "\n节点与基点桩号差值:")
    (princ (* dpnum1 (abs (- dp1dist1 ep1dist1))))
    (setq dp1k (+ k1 (* dpnum1 (- dp1dist1 ep1dist1))))   ;节点桩号值
    (princ "\n节点桩号:")
    (princ dp1k)
   
    ;;里程桩内容
    (setq dp1k2 (atof (rtos dp1k 2 kacc1)))     
    (setq k (fix (* 0.001 dp1k2))               ;千位及以上部分
          m (- dp1k2 (* k 1000.000))            ;百位及以下部分
    )               ;分别计算整数和小数部分
    (setq mstr (rtos m 2 kacc1))         ;将数字转换为字符串，保留kacc1位小数
    (if (= kacc1 0)
        (setq kacc3 (- kacc1 1))
        (setq kacc3 kacc1)      
    )
    (setq mstr2 (cond
                  ((= (+ kacc3 4) (strlen mstr)) mstr)
    ((= (+ kacc3 3) (strlen mstr)) (strcat "0" mstr))
    ((= (+ kacc3 2) (strlen mstr)) (strcat "00" mstr))   
  )
    )   
    (if (> (strlen mstr) 4)
        (setq mstr2 (vl-string-right-trim "." (vl-string-right-trim "0" mstr2)))
    )
    (setq dpstr3 (strcat kname1 (itoa k) "+" mstr2))
   
    ;;标注文字角度
    (setq dir1 (vlax-Curve-GetFirstDeriv el (vlax-Curve-GetParamatPoint el 1dp1)))   ;法线向量
    (setq ang1 (atan (/ (cadr dir1) (car dir1))))
    ;实时显示修订起点
   
    ;标注起始点
;    (setq dp2 (getpoint "\n选择标注起始点:"))
    ;新建节点名称文字，后续修改
    (entmake (list '(0 . "TEXT")
                    (cons 1 "节点名称")          ;默认值(字符串本身)
                   '(10 0 0 0)            ;第一对齐点(在OCS中)DXF:X值
                    (cons 40 3)       ;文字高度
                    (cons 50 0)        ;旋转角度，弧度表示
                    (cons 7 "smedi")      ;文字样式
                    (cons 41 0.7)         ;宽度因子
     '(11 0 0 0)
      (cons 72 0)
      (cons 73 1)
             )
    )
    (setq jdtxt1 (entget (entlast)))       ;新建文字定义为jdtxt1
    ;新建节点桩号文字，后续修改
    (entmake (list '(0 . "TEXT")
                    (cons 1 "节点桩号")          ;默认值(字符串本身)
                   '(10 0 0 0)            ;第一对齐点(在OCS中)DXF:X值
                    (cons 40 3)       ;文字高度
                    (cons 50 0)        ;旋转角度，弧度表示
                    (cons 7 "smedi")      ;文字样式
                    (cons 41 0.7)         ;宽度因子
     '(11 0 0 0)
      (cons 72 0)
      (cons 73 1)
             )
    )
    (setq zhtxt1 (entget (entlast)))       ;新建文字定义为jdtxt1
    (setq loop T)                      ;
    ;动态循环开始
    (while loop                        ;
      (setq code (grread T 4 1)        ;函数返回一个表，其中第一个元素说明输入类型的代码，第二个元素既可能是整数，又可能是点，这取决于输入的类型。
            mod  (car code)            ;输入类型代码
            dp2  (cadr code)           ;第二个元素既可能是整数，又可能是点，这取决于输入的类型
      )
      (cond (  (= 5 mod)                 ;;cond第一表达式
  
               ;生成文字标注
               ;节点名称修改
               (setq nameang1 (+ ang1 (atan 0.6 1.5)))  ;节点名称角度
               (setq namept1 (polar dp2 nameang1 (* (/ txth1 3.0) (sqrt (+ (* 1.5 1.5) (* 0.6 0.6))))));节点名称位置

               (setq jdtxt1 (subst (cons 1 name1) (assoc 1 jdtxt1) jdtxt1))  
               ;;修改文字内容
               (setq jdtxt1 (subst (cons 10 namept1) (assoc 10 jdtxt1) jdtxt1))  
               ;;修改文字坐标
        (setq jdtxt1 (subst (cons 11 namept1) (assoc 11 jdtxt1) jdtxt1))  
               ;;修改文字坐标
               (setq jdtxt1 (subst (cons 40 txth1) (assoc 40 jdtxt1) jdtxt1))  
               ;;修改文字高度
               (setq jdtxt1 (subst (cons 50 ang1) (assoc 50 jdtxt1) jdtxt1))  
               ;;修改文字角度
               ;;更新图元名列表
               (entmod jdtxt1)
      
               ;节点桩号修改
               (setq nameang2 (- ang1 (atan 3.5 1.5)))  ;节点桩号角度
               (setq zhpt1 (polar dp2 nameang2 (* (/ txth1 3.0) (sqrt (+ (* 1.5 1.5) (* 3.5 3.5))))));节点桩号位置
               ;(setq zhtxt1 (entget (entlast)))
               (setq zhtxt1 (subst (cons 1 dpstr3) (assoc 1 zhtxt1) zhtxt1))  
               ;;修改文字内容
               (setq zhtxt1 (subst (cons 10 zhpt1) (assoc 10 zhtxt1) zhtxt1))  
               ;;修改文字坐标
        (setq zhtxt1 (subst (cons 11 zhpt1) (assoc 11 zhtxt1) zhtxt1))  
               ;;修改文字坐标
               (setq zhtxt1 (subst (cons 40 txth1) (assoc 40 zhtxt1) zhtxt1))  
               ;;修改文字高度
               (setq zhtxt1 (subst (cons 50 ang1) (assoc 50 zhtxt1) zhtxt1))  
               ;;修改文字角度
               ;;更新图元名列表
               (entmod zhtxt1)
        
               ;画下划线
               ;节点名称
               (setq jdtxtbox1 (textbox jdtxt1))
               (setq jdtxtp1 (car jdtxtbox1))
               (setq jdtxtp3 (cadr jdtxtbox1))
               (setq jdtxtp2 (list (car jdtxtp3)(cadr jdtxtp1)))
               (setq jdtxtp4 (list (car jdtxtp1)(cadr jdtxtp3)))
  
               ;节点桩号
               (setq zhtxtbox1 (textbox zhtxt1))
               (setq zhtxtp1 (car zhtxtbox1))
               (setq zhtxtp3 (cadr zhtxtbox1))
               (setq zhtxtp2 (list (car zhtxtp3)(cadr zhtxtp1)))
               (setq zhtxtp4 (list (car zhtxtp1)(cadr zhtxtp3)))

               (redraw)                  ;如果不带参数调用 redraw 函数，它重画当前视口。如果调用它时提供了图元名，它将重画该指定图元。
               (grdraw dp1 dp2 3)        ;在当前视口中的两个点之间显示一条矢量线
               (grdraw dp2 (polar dp2 ang1
                                  (+ (max (distance jdtxtp1 jdtxtp2) (distance zhtxtp1 zhtxtp2))
         (* (/ txth1 3.0) 3)
      )
                        )
         3)        ;在当前视口中的两个点之间显示一条矢量线
            );(= 5 mod)结束
            
            ;;cond第二表达式,鼠标左键、右键退出画线
            (
               (or (= 25 mod) (= 3 mod))  ;
        (command "_line" dp1 dp2 "") ;画节点至标注起始点支线   
               (command "line" dp2 (polar dp2 ang1
                                          (+ (max (distance jdtxtp1 jdtxtp2)
                             (distance zhtxtp1 zhtxtp2)
                               )
                               (* (/ txth1 3.0) 3)
                                          )
                                ) ""
               )
        (setq loop nil)
            )
      );cond结束
    );loop while动态循环结束
    ;是否修改节点名称
    (setq op2 "N")
    (progn
      (prompt "\n是否修改节点名称？[是(Y)/否(N)]:<")
      (prin1 op2)
      (prompt ">")
      (setq op2 (getstring)) ;输入选项
    )   
    (if (= op2 "y") (setq name1 (getstring "\n输入新节点名称:")))
         
  )  ;while结束
  (setq *error* temperr)
  (vl-cmdf "UCS" "P")           ;返回前一个坐标系
  (setvar "osmode" 4143)   ;(setvar "osmode" os_old)获取原捕捉模式会出错，所以重新设置
  (setvar "CMDECHO" cmd_old)      ;恢复原回显设置
  (princ)
)
  

baitang36

看看是否是捕捉的问题？

cocoorange

baitang36 发表于 2019-1-2 09:54
看看是否是捕捉的问题？

不是捕捉的问题，后来重装系统，重装CAD之后就好了