源码啊。要是基本尺寸可以改就更好了。
试试这个
本帖最后由 chg 于 2011-11-30 18:48 编辑
Z版的程序出现如下错误：错误， no function definition: SUSTR，如果打开对话框后一下都不更改，正确运行，改变其中参数后，出现这样的错误。
chg 发表于 2011-11-30 18:47 static/image/common/back.gif
Z版的程序出现如下错误：错误， no function definition: SUSTR，如果打开对话框后一下都不更改，正确运行， ...
我运行时没问题啊。不过奇怪的是，我也没在LSP中找到sustr的定义，看来它在某个系统文件里，也许我有你没有。
ZZXXQQ 发表于 2011-11-30 11:26 static/image/common/back.gif
试试这个
Z版，sustr是在哪里定义的？我怎么能直接运行？
经查明，Z版的程序确实没有定义sustr函数，在公差代号选择JS或js时将出错。希望Z版改进，也希望大家多下载我的程序，因为我的不出错。哈哈
本帖最后由 ZZXXQQ 于 2011-12-3 10:17 编辑
改了下，再试试。
;公差查询
(defun c:gccx () ;主程序
(setvar "CMDECHO" 0);关闭命令显示
(setq zlst '("a" "b" "c" "cd" "d" "e" "ef" "f" "fg" "g" "h" "js" "j" "k" "m" "n" "p" "r" "s" "t" "u" "v" "x" "y" "z" "za" "zb" "zc"))
;轴公差代号表
(setq klst (mapcar 'strcase zlst));孔公差代号表
(setq jdlst '("01" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18"))
;公差等级表
(setq kong nil) ;初始化变量，确保对话框初始设定只运行一次
(IF (> (setq dcl_id (load_dialog (findfile "gongcha.dcl"))) 0) (progn ;加载对话框
(if (new_dialog "gongcha" dcl_id "") (progn ;开始显示对话框
(if (not kong) (progn ;判断变量是否为“空”。保证对话框只运行一次
(setq kong (get_tile "kong")) ;从对话框读入参数kong
(start_list "gcdh") ;开始列表gcdh(公差代号)
(mapcar 'add_list (if (= kong "1") klst zlst)) ;判断变量是否选择了“孔”，从而决定列表字母的大小写
(end_list) ;结束列表
(set_tile "gcdh" "10") ;设置列表显示行(h/H)
(start_list "jddj") ;开始列表jddj(精度等级)
(mapcar 'add_list jdlst) ;列表赋值
(end_list) ;结束列表
(set_tile "jddj" "8") ;设置列表显示行(7)
(mdata) ;执行对话框显示子程序mdata
))
(action_tile "kong" "(mdata1)");若对话框标题kong活动，执行对话框显示子程序mdata1
(action_tile "user" "(mdata)") ;
(action_tile "gcdh" "(mdata)") ;
(action_tile "jddj" "(mdata)") ;若对话框项目user,gcdh,jddj,phi,cc活动，执行对话框显示子程序mdata
(action_tile "phi" "(mdata)");
(action_tile "cc" "(mdata)") ;
(action_tile "accept" "(readata) (done_dialog 1)") ;按下确定(Ok)按钮，执行读数子程序readata并以返回值1结束对话框
(action_tile "cancel" "(done_dialog 0)") ;按下取消(Cancel)按钮，以返回值0结束对话框
(setq re (start_dialog)) ;显示对话框并在对话框结束时取得返回值
)
(princ "\n无法显示对话框！") ;错误信息
)
(unload_dialog dcl_id) ;从内存中卸载对话框
)
(princ "\n无法加载对话框！") ;错误信息
)
(if (= re 1) (draw)) ;如果以确定(Ok)按钮结束对话框，执行修改尺寸函数draw
(setvar "CMDECHO" 1) ;打开命令显示
(princ) ;阻止返回值，安静退出主程序
)
(defun draw () ;修改尺寸子程序
(if (and (princ "\n选择尺寸: ") (setq ss (ssget '((0 . "DIMENSION"))))) (progn ;选择已经标好的尺寸，空选择平静退出
(if (/= use "0") ;是否为用户定义偏差
(if (= (substr spc 2) (substr xpc 2)) ;上下偏差尾数相同
(setq txt (cons 1 (strcat qz "<> %%p" (substr spc 2)))) ;以正负号标注偏差
(setq txt (cons 1 (strcat qz "<> {\\H0.7x;\\S" spc "^" xpc ";}"))) ;以上下偏差标注
)
)
(setq i 0) ;循环变量
(repeat (sslength ss) ;开始循环遍历选择集
(setq ent (entget(ssname ss i))) ;取出第i个尺寸数据
(if (= use "0") ;如果不是用户定义偏差
(cond
((or (= (setq txt (cdr(assoc 1 ent))) "") (wcmatch txt "*<>*")) ;如果标注字串为空或包含实际尺寸
(setq dd (cdr(assoc 42 ent))) ;从尺寸数据中读出实际尺寸
(cgc dd cd acc) ;查表确定该尺寸的上下偏差值
(if (= spc "0") (setq spc (strcat "" spc))) ;如果上偏差为零，在"0"前加两个空格(对齐显示，如字体不同可增减)
(if (= xpc "0") (setq xpc (strcat "" xpc))) ;……下……
(if (= (strcase CD) "JS") ;如果公差代号为JS，以正负号标注偏差，否则以上下偏差标注
(setq txt (cons 1 (strcat qz "<>" CD ACC "( %%p" (substr spc 2) " )")))
(setq txt (cons 1 (strcat qz "<>" CD ACC "( {\\H0.7x;\\S" spc "^" xpc "; })")))
)
)
((/= (setq dd (if (/= (substr txt 1 2) "%%") (atof txt) (atof (substr txt 4)))) 0.0) ;如果原标注字串由用户书写，开头有转义字符，且数值不为零
(cgc dd cd acc) ;查表确定该用户书写尺寸的上下偏差值
(if (= spc "0") (setq spc (strcat "" spc))) ;同前
(if (= xpc "0") (setq xpc (strcat "" xpc))) ;同前
(if (= (strcase CD) "JS") ;同前
(setq txt (cons 1 (strcat qz txt CD ACC "( %%p" (substr spc 2) " )")))
(setq txt (cons 1 (strcat qz txt CD ACC "( {\\H0.7x;\\S" spc "^" xpc "; })")))
)
)
)
)
(entmod (subst txt (assoc 1 ent) ent)) ;更改尺寸数据表，更新尺寸显示
(setq i (1+ i)) ;循环变量加1
)
))
)
(defun mdata1 () ;对话框显示子程序
(setq kong (get_tile "kong")) ;
(setq gcdh (get_tile "gcdh")) ;读取数据kong,gcdh,jddj
(setq jddj (get_tile "jddj")) ;
(start_list "gcdh") ;同前
(mapcar 'add_list (if (= kong "1") klst zlst));同前
(end_list)
(set_tile "gcdh" gcdh) ;设置列表显示，保持原来显示行
(start_list "jddj")
(mapcar 'add_list jdlst)
(end_list)
(set_tile "jddj" jddj) ;设置列表显示，保持原来显示行
)
(defun mdata () ;对话框显示子程序
(if (= (get_tile "user") "1") (progn ;若用户定义
(mode_tile "kong" 1) ;禁止修改
(mode_tile "gcdh" 1) ;禁止修改
(mode_tile "jddj" 1) ;禁止修改
(mode_tile "spc" 0) ;激活修改
(mode_tile "xpc" 0) ;激活修改
) (progn
(mode_tile "kong" 0) ;激活修改
(mode_tile "gcdh" 0) ;激活修改
(mode_tile "jddj" 0) ;激活修改
(mode_tile "spc" 1) ;禁止修改
(mode_tile "xpc" 1) ;禁止修改
))
(setq cc (atof (get_tile "cc"))) ;读取尺寸值
(setq gcdh (nth (atoi (get_tile "gcdh")) (if (= (get_tile "kong") "1") klst zlst))) ;读取公差代号
(setq jddj (nth (atoi (get_tile "jddj")) jdlst)) ;读取精度等级
(set_tile "qz" (if (= (get_tile "phi") "1") "%%c" "")) ;读取前缀设置
(cgc cc gcdh jddj) ;查公差
(set_tile "spc" spc) ;上偏差赋值
(set_tile "xpc" xpc) ;下偏差赋值
)
(defun readata () ;读数子程序
(if (= (setq use (get_tile "user")) "0") ;若偏差非用户定义
(setq DD (get_tile "cc") ;读取尺寸值
CD (nth (atoi (get_tile "gcdh")) (if (= (get_tile "kong") "1") klst zlst)) ;读取公差代号
ACC (nth (atoi (get_tile "jddj")) jdlst)) ;读取精度等级
(setq DD (get_tile "cc") ;用户定义，读取尺寸
cd "" ;置公差代号和精度等级为空串
acc "")
)
(setq qz (get_tile "qz")) ;读取前缀
(setq spc (get_tile "spc")) ;读取上偏差
(setq xpc (get_tile "xpc")) ;读取下偏差
(if (= spc "0") (setq spc (strcat "" spc))) ;同前
(if (= xpc "0") (setq xpc (strcat "" xpc))) ;同前
)
(defun cgc (DD CD ACC) ;查公差子程序
(if (setq nm (findfile "GB1800.DAT")) (progn ;如果数据文件GB1800.DAT存在
(setq f (open nm "r")) ;打开数据文件
(read-line f) ;空读一行
(setq dl (read (read-line f))) ;读一行数据
(while (< (car DL) DD) (setq dl (read (read-line f)))) ;在表中匹配尺寸
(setq TT nilC (strcase CD) ;设初值C中为大写公差代号
NK
(cond ((= C "A") 1)((= C "B") 2)((= C "C") 3)
((= C "CD") 4) ((= C "D") 5)((= C "E") 6)
((= C "EF") 7) ((= C "F") 8)((= C "FG") 9)
((= C "G") 10) ((= C "M") 11) ((= C "N") 12)
((= C "P") 13) ((= C "R") 14) ((= C "S") 15)
((= C "T") 16) ((= C "U") 17) ((= C "V") 18)
((= C "X") 19) ((= C "Y") 20) ((= C "Z") 21);根据公差代号确定数据位置
((= C "ZA") 22) ((= C "ZB") 23) ((= C "ZC") 24) ))
(setq AC (IF (= ACC "01") 1 (+ (ATOI ACC) 2)) ;根据精度等级确定数据位置
IT (* (NTH AC DL) 0.001)) ;查表计算公差值
(IF (= CD "h") (PROGN ; AXIS基准轴
(setq spc "0") ;上偏差
(setq xpc (rtos (- it) 2 3)) ;下偏差为负数
))
(IF (= CD "H") (progn ; HOLE基准孔
(setq spc (strcat "+" (rtos it 2 3))) ;上偏差为正数，数前加+号
(setq xpc "0") ;下偏差
))
(IF (= C "JS") (progn ;公差代号JS
(setq spc (strcat "+" (rtos (/ it 2) 2 3))) ;上偏差为正数，数前加+号
(setq xpc (rtos (/ it -2) 2 3)) ;下偏差为负数
))
(IF (OR (< C "H") (> C "K")) (PROGN ;公差代号在H-K范围之外的
(SETQ SS (IF (<= DD 500) "GB1800-2" ;如果尺寸小于等于500设置查表关键字为GB1800-2
(IF (AND (> AC 6) (>= C "D") (< C "V")) "GB1800-3")));如果精度等级大于6且公差代号大于等于D且小于V设置查表关键字为GB1800-3
(IF (/= SS nil) (PROGN ;如果查表关键字不为空
(WHILE (/= (READ-LINE F) SS)) ;读到表头为止
(SETQ DL (READ (READ-LINE F))) ;读取一行
(WHILE (< (CAR DL) DD) (SETQ DL (READ (READ-LINE F)))) ;读取判断尺寸区间
(SETQ TT (NTH NK DL)) ;读取偏差值
))
))
(IF (OR (= C "J") (= C "K")) (PROGN ;如果公差代号为J或K
(SETQ SS (IF (<= DD 500) "JK" nil)) ;设置查表关键字为JK
(IF (/= SS nil) (PROGN ;若关键字不为空
(WHILE (/= (READ-LINE F) SS)) ;读到表头为止
(SETQ DL (READ (READ-LINE F))) ;读取一行
(WHILE (< (CAR DL) DD) (SETQ DL (READ (READ-LINE F)))) ;读取判断尺寸区间
(SETQ TT (NTH ;读取偏差值
(IF (= C "J")
(IF (> CD "a") (IF (< AC 9) 1 2) ; AXIS轴
(IF (= AC 8) 5 (IF (= AC 9) 6 7))) ; HOLE孔
(IF (> CD "a") (IF (< 5 AC 10) 3 4) ; AXIS轴
(IF (> AC 10) 9 8))) DL)) ; HOLE孔
(IF (AND (= CD "J") (OR (< AC 8) (> AC 10))) (SETQ TT nil));表中无内容，设偏差为空
(IF (AND (= AC 10) (= CD "j"))
(IF (> DD 3) (SETQ DD nil) (SETQ DD -6)))
(IF (AND (= CD "j") (OR (< AC 7) (> AC 10))) (SETQ TT nil));表中无内容，设偏差为空
))
))
(IF (AND (< 4 AC 11) (/= C "JS") (< "J" CD "P")) (PROGN
(WHILE (/= (READ-LINE F) "DLTA"))
(SETQ DL (READ (READ-LINE F))) ;读取一行
(WHILE (< (CAR DL) DD) (SETQ DL (READ (READ-LINE F)))) ;读取判断尺寸区间
(SETQ TT (- TT (NTH (- AC 4) DL))) ;读取偏差值
))
(IF (AND (> CD "N") (<= CD "ZC") (< 4 AC 10)) (PROGN ;如果公差代号在N-ZC之间，精度等级在5-10之间
(WHILE (/= (READ-LINE F) "DLTA")) ;查附加表
(SETQ DL (READ (READ-LINE F))) ;读取一行
(WHILE (< (CAR DL) DD) (SETQ DL (READ (READ-LINE F)))) ;读取判断尺寸区间
(SETQ TT (- TT (NTH (- AC 4) DL))) ;读取偏差值
))
(IF (AND (> AC 10) (= CD "N")) (IF (> DD 3) (SETQ TT 0) (SETQ TT 4)));特殊偏差
(IF (AND (= CD "k") (OR (> AC 9) (< AC 6))) (SETQ TT 0)) ;特殊偏差
(IF (/= TT nil) (PROGN
(SETQ TT (* TT 0.001) SIGN (IF (< TT 0) "+" "")) ;计算偏差值，设置符号
(IF (> CD "ZC") ; AXIS轴
(IF (< CD "h") (progn ;公差代号小于基准轴
(setq spc (strcat (if (> tt 0) "+" "") (rtos tt 2 3))) ;上偏差，正数前加+号
(setq xpc (strcat (if (> (- tt it) 0) "+" "") (rtos (- tt it) 2 3)));下偏差，正数前加+号
)
(IF (= TT 0.0) (progn ;偏差为零
(setq spc (strcat "+" (rtos it 2 3))) ;上偏差，正数前加+号
(setq xpc "0") ;下偏差
) (progn
(setq spc (strcat (if (> (+ tt it) 0) "+" "") (rtos (+ tt it) 2 3)));上偏差，正数前加+号
(setq xpc (strcat (if (> tt 0) "+" "") (rtos tt 2 3))) ;下偏差，正数前加+号
)) ; END IF TT=0
) ; ENDIF CD<"h"
(IF (< CD "H") (progn ; HOLE孔。公差代号小于基准孔
(setq spc (strcat (if (> (- it tt) 0) "+" "") (rtos (- it tt) 2 3)));上偏差，正数前加+号
(setq xpc (strcat (if (> (- tt) 0) "+" "") (rtos (- tt) 2 3))) ;下偏差，正数前加+号
)
(IF (= TT 0.0) (PROGN ;偏差为零
(setq spc "0") ;上偏差
(setq xpc (strcat "-" (rtos (+ tt it) 2 3))) ;下偏差，正数前加-号
) (progn
(setq spc (strcat sign (rtos (- tt) 2 3))) ;上偏差
(setq xpc (strcat "-" (rtos (+ tt it) 2 3))) ;下偏差
)) ; ENDIF TT=0
) ; ENDIF CD<"H"
) ; ENDIF CD>"ZC"
)) ; ENDIF TT<>nil
(CLOSE F) ;关闭数据文件
))
) ; ENDDEFUN CGC
不是笔误，是手误。
Z版更改后，能正常使用了，两个程序功能一致，各有千秋
楼主收钱，呵呵，不敢下了，上次下载两次，钱没了，东西也没到手。