lisp正负调换_Lisp插件在WIN10系统下不能运行的问题

这是一个标注节点桩号的程序，这个程序在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)

)