实用工具

2443725 · 发表于 2004-5-17 20:44

操作方法：把下面的源程序copy到acad2000.lsp或acad2004.lsp文件的后面，保存。 重启动AutoCAD， OK!!! 命令说明： partleader半自动零件标号、FDd局部放大、QCBH基准标号、cczp加工精度、qm qmh qmk画螺纹 dimqtol快速公差标注、Lineon和Lineoff视图投影画线。 Lineoff用法：第二步画一条线与其它线相交，然后点选它们的交点。 可以把这些命令名改成你想要的命令名，只要不冲突 ;;;ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp (defun c:partleader(/) (setvar "CMDECHO" 0) (setvar "ORTHOMODE" 0) (setvar "OSMODE" 0) (if (null modelss) (setq modelss 1) ) (setq cc (getvar "DIMLDRBLK")) (setq ssa (getvar "DIMASZ")) (command "osmode" "0") (if (null basetext2 ) (setq basetext2 1) ) (if (null tthjlk) (setq tthjlk (getvar "DIMTXT")) ) (setq cguvh tthjlk ) (if (null basedx2) (setq basedx2 10) ) (cond ((= modelss 0)(leader_v)) ((= modelss 1)(leader_h)) ((= modelss 2) (leader_o)) ) (cond ((= modelss 0)(model22)) ((= modelss 1)(model11)) ((= modelss 2) (oleader22)) ) ) ;;;kkkkkkkkkkkkkkkcfghfdgfdggggggggggggggggggggggddddddddddddddddd (defun c:FDd() (setq veracad (atoi (getvar "ACADVER"))) (if (>= veracad 15) (fdd2000) (fdd14) ) ) (defun c:qm() (setvar "cmdecho" 0) (setq p0 (getpoint "\n中心点：")) (setq r0 (* (getdist "\n螺纹直径：") 0.5)) (setq x0 (car p0)) (setq y0 (cadr p0)) (if (<= r0 10) (progn (setq r2 (- r0 0.5)) )) (if (> r0 10) (progn (setq r2 (- r0 1)) )) (entmake (list (cons 0 "ARC") (cons 8 "TITLE") (list 10 x0 y0 0.0) (cons 40 r0) (list 210 0.0 0.0 1.0) (cons 50 4.71239) (cons 51 3.14159))) (entmake (list (cons 0 "circle") (cons 8 "0") (list 10 x0 y0 0.0) (cons 40 r2) (list 210 0.0 0.0 1.0) )) (princ ) ) (defun c:qmh() (setvar "cmdecho" 0) (setq p0 (getpoint "\n基准点：")) (setq r0 (* (getdist "\n螺纹直径：") 0.5)) (setq x0 (car p0)) (setq y0 (cadr p0)) (if (<= r0 10) (progn (setq r2 (- r0 0.5)) )) (if (> r0 10) (progn (setq r2 (- r0 1)) )) (setq l (getdist "\n螺纹长度：")) (setq x1 (+ x0 l)) (setq xk (+ x0 l 2 (* 0.57735 r2))) (setq y1 (+ y0 r0)) (setq y11 (- y0 r0)) (setq y2 (+ y0 r2)) (setq y22 (- y0 r2)) (setq kkk (ssadd)) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 x0 y2 0.0) (list 11 (+ 2 x1) y2 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 x0 y22 0.0) (list 11 (+ 2 x1) y22 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 (+ 2 x1) y2 0.0) (list 11 (+ 2 x1) y22 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 (+ 2 x1) y2 0.0) (list 11 xk y0 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 (+ 2 x1) y22 0.0) (list 11 xk y0 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "TITLE") (list 10 x0 y1 0.0) (list 11 x1 y1 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "TITLE") (list 10 x0 y11 0.0) (list 11 x1 y11 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "line") (cons 8 "0") (list 10 x1 y11 0.0) (list 11 x1 y1 0.0) )) (ssadd (entlast) kkk) (command "ORTHOMODE""1") (command "rotate" kkk "" p0) ) (defun c:qmk() (setvar "cmdecho" 0) (setq p0 (getpoint "\n基准点：")) (setq r0 (* (getdist "\n螺纹直径：") 0.5)) (setq x0 (car p0)) (setq y0 (cadr p0)) (if (<= r0 10) (progn (setq r2 (- r0 0.5)) )) (if (> r0 10) (progn (setq r2 (- r0 1)) )) (setq l (getdist "\n螺纹长度：")) (setq x1 (+ x0 l)) (setq y1 (+ y0 r0)) (setq y11 (- y0 r0)) (setq y2 (+ y0 r2)) (setq y22 (- y0 r2)) (setq kkk (ssadd)) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 x0 y2 0.0) (list 11 x1 y2 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "0") (list 10 x0 y22 0.0) (list 11 x1 y22 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "TITLE") (list 10 x0 y1 0.0) (list 11 x1 y1 0.0) )) (ssadd (entlast) kkk) (entmake (list (cons 0 "LINE") (cons 8 "TITLE") (list 10 x0 y11 0.0) (list 11 x1 y11 0.0) )) (ssadd (entlast) kkk) (command "ORTHOMODE""1") (command "rotate" kkk "" p0) ) ;;;KKKKKKKKKKKKKKKKKKKKKKKKKKKKKK (defun c

CBH() (setvar "OSMODE" 0) (setvar "ORTHOMODE" 1) (C:NOW2) (princ "\n基准标号") (if (null hhttv) (setq hhttv (getvar "DIMTXT")) ) (setq p3 "t") (while (= p3 "t") (initget "t") (setq p3 (getpoint "\n 字高(T)/请输入基点:")) (if (= p3 "t") (setq hhttv (getdist "\n请输入字高:")) ) ) (setq x3 (car p3)) (setq y3 (cadr p3)) (setq p1 (list (- x3 (* 0.6 hhttv)) y3)) (setq p2 (list (+ x3 (* 0.6 hhttv)) y3)) (setq p4 (list x3 (+ y3 (* 0.43 hhttv)) )) (setq p0 (list x3 (+ y3 (* 1.2 hhttv)) )) (setq y0 (+ y3 (* 1.2 hhttv))) (setq kkk (ssadd)) (command "line" p1 p2 "") (command ) (ssadd (entlast) kkk) (command "line" p3 p4 "") (command ) (ssadd (entlast) kkk) (command "circle" p0 (* hhttv 0.77) ) (command ) (ssadd (entlast) kkk) (setq stre26 (strcase (getstring "\n请输入文本:"))) (make_text2 x3 y0 10 hhttv 5 stre26) (ssadd (entlast) kkk) (setq ttm (entlast)) (command "rotate" kkk "" p3 ) (command pause) (setq kuu (entget ttm )) (setq ttm (subst (cons 50 0) (assoc 50 kuu) kuu)) (entmod ttm) (princ) ) (defun c:lineon(/) (SETVAR "CMDECHO" 0) (SETVAR "BLIPMODE" 0) (command "ORTHOMODE""1") (command "OsMODE""183") (command "line"pause pause"") (setq ghk (entlast)) (setq kkk (assoc 11 (entget ghk))) (setq p0 (list (cadr kkk)(caddr kkk))) (command "erase"ghk"") (setvar "OSMODE" 0) (command "line" p0 ) (setvar "OSMODE" 163) ) (defun c:lineoff(/) (setvar "cmdecho" 0) (command "ORTHOMODE""1") (command "OsMODE""183") (command "line"pause pause pause"") (command "undo""") (command "OsMODE""0") (command "line""@0,0") (setvar "OSMODE" 163) ) ;;;yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy (defun c:cczp() (setvar "OSMODE" 640) (setvar "ORTHOMODE" 0) (setq p3 "t") (while (or (= p3 "v") (= p3 "b") (= p3 "n")(= p3 "m")(= p3 "t")(= p3 "o")(= p3 "j")(= p3 "c")) (initget "c v b n m t o j") (setq p3 (getpoint "\n [非加工(O)/其余(J)/字高(T)/固定文本12.5(C)/6.3(V)/3.2(B)/1.6(N)/非固定文本(M)] 请输入基点:")) (cond ((= p3 "c") (setq chsvn "12.5")) ((= p3 "v") (setq chsvn "6.3")) ((= p3 "b") (setq chsvn "3.2")) ((= p3 "n") (setq chsvn "1.6")) ((= p3 "m") (setq chsvn nil)) ((= p3 "t") (setq hhttk (getdist "\n请输入文本高度:"))) ((= p3 "o") (ooo)) ((= p3 "j") (jjuu)) ) ) (setq x3 (car p3)) (setq y3 (cadr p3)) (if (null hhttk) (setq tth (getvar "DIMTXT")) (setq tth hhttk) ) (setq hkgm (* 1.4 tth)) (setq dx (* hkgm (/ (sin (/ pi 6))(cos (/ pi 6))))) (setq x1 (+ x3 dx)) (setq x2 (- x3 dx)) (setq x4 (+ x3 (* 2 dx))) (setq y1 (+ y3 hkgm)) (setq y2 y1) (setq y4 (+ y3 (* 2 hkgm))) (setq p1 (list x1 y1)) (setq p2 (list x2 y2)) (setq p4 (list x4 y4)) (setq p5 (list x3 (+ y3 (* 0.8 hkgm)))) (setvar "OSMODE" 0) (setq kkk (ssadd)) (command "line" p1 p2 "") (setq LL1 (entlast) ) (ssadd (entlast) kkk) (command "line"p2 p3 "") (setq LL2 (entlast) ) (ssadd (entlast) kkk) (command "line"p3 p4 "") (setq LL3 (entlast) ) (ssadd (entlast) kkk) (if (null hhttk) (setq tth (getvar "DIMTXT")) (setq tth hhttk) ) (setq y5 (+ y1 (* tth 0.741) )) (if (null chsvn) (progn (if (null oldtext) (setq stre (getstring "\n请输入文本:")) (setq stre (getstring (strcat "\n请输入文本<" oldtext ">:"))) ) (if (= stre "") (setq stre oldtext) ) ) (setq stre chsvn) ) (setq oldtext stre) (make_text2 x3 y5 10 tth 5 stre) (setq ttm (entlast)) (ssadd (entlast) kkk) (if (/= oo nil) (notext) ) (if (null jkh) (progn (command "rotate" kkk "" p3 ) (setvar "OSMODE" 640) (command pause) ) (jjyy) ) (setq kuu (entget ttm )) (setq ttm (cdr (assoc 50 kuu ))) (if (and (> ttm (* (* pi 0.53) 1)) (< ttm (* (/ pi 3) 5))) (setq ttm (- ttm pi)) ) (setq ttm (subst (cons 50 ttm) (assoc 50 kuu) kuu)) (entmod ttm) (princ) ) ;;aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa (defun model11 () (setvar "CMDECHO" 0) (command "line" p1 ) (PRINC "\n请输入第二点:") (command pause "") (setq f1 (entlast)) (setq ppk (entget f1)) (command "erase" f1 "") (setq x1 (car p1)) (setq yy2 (caddr (assoc 11 ppk))) (if (null basepoint2) (progn (setq y2 yy2) (setq basepoint2 yy2) ) (setq y2 basepoint2) ) (setq x2 (cadr (assoc 11 ppk))) (setq p2 (list x2 y2)) (if (<= x1 x2) (setq x3 (+ x2 basedx2)) (setq x3 (- x2 basedx2)) ) (setq p3 (list x3 y2)) (setq y4 (+ (/ tthjlk 1.2) y2 )) (setq x4 (/ (+ x3 X2) 2)) (setvar "ORTHOMODE" 0) (setvar "OSMODE" 0) (setvar "DIMASZ" (* 0.16 ssa)) (command "DIMLDRBLK" "dot" ) (command "leader" p1 p2 p3 "" "" "n") (command "DIMLDRBLK" cc ) (setvar "DIMASZ" ssa) (SETQ KKK (itoa basetext2)) (make_text2 x4 y4 10 tthjlk 5 KKK) (setq basetext2 (+ basetext2 1)) (setq basetext33 basetext2) (princ) ) ;;ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss

2443725 · 发表于 2004-5-17 20:45

(defun model22 () (setvar "CMDECHO" 0) (command "line" p1 ) (PRINC "\n请输入第二点:") (command pause "") (setq f1 (entlast)) (setq ppk (entget f1)) (command "erase" f1 "") (setq x1 (car p1)) (setq xx2 (cadr (assoc 11 ppk))) (if (null basepoint2) (progn (setq x2 xx2) (setq basepoint2 xx2) ) (setq x2 basepoint2) ) (setq y2 (caddr (assoc 11 ppk))) (setq p2 (list x2 y2)) (if (<= x1 x2) (setq x3 (+ x2 basedx2)) (setq x3 (- x2 basedx2)) ) (setq p3 (list x3 y2)) (setq y4 (+ (/ tthjlk 1.2) y2 )) (setq x4 (/ (+ x3 X2) 2)) (setvar "ORTHOMODE" 0) (setvar "OSMODE" 0) (setvar "DIMASZ" (* 0.16 ssa)) (command "DIMLDRBLK" "dot" ) (command "leader" p1 p2 p3 "" "" "n") (command "DIMLDRBLK" cc ) (setvar "DIMASZ" ssa) (SETQ KKK (itoa basetext2)) (make_text2 x4 y4 10 tthjlk 5 KKK) (setq basetext2 (+ basetext2 1)) (setq basetext33 basetext2) (princ) ) (defun pntoxls-all(ff1 ff2) (setq kkk (open ff1 "r")) (setq ff (open ff2 "w")) (write-line "TABLE" ff) (write-line "0,1" ff) (write-line "\"EXCEL\"" ff) (write-line "VECTORS" ff) (write-line "0,5" ff) (write-line "\"\"" ff) (write-line "TUPLES" ff) (write-line "0,3" ff) (write-line "\"\"" ff) (write-line "DATA" ff) (write-line "0,0" ff) (write-line "\"\"" ff) (write-line "-1,0" ff) (while (setq sss (read-line kkk)) (setq sss (read sss)) (write-line "BOT" ff) (write-line "1,0" ff) (write-line (strcat "\"" (nth 0 sss) "\"" ) ff) (write-line "1,0" ff) (write-line (strcat "\"" (nth 1 sss) "\"" ) ff) (write-line "1,0" ff) (write-line (strcat "\"" (nth 2 sss) "\"" ) ff) (write-line "1,0" ff) (write-line (strcat "\"" (nth 5 sss) "\"" ) ff) (write-line "1,0" ff) (write-line (strcat "\"" (nth 3 sss) "\"" ) ff) (write-line "1,0" ff) (write-line (strcat "\"" (nth 4 sss) "\"" ) ff) (write-line "-1,0" ff) ) (write-line "EOD" ff) (close ff) (close kkk) ) (defun vors() (setvar "CMDECHO" 0) (princ "\n进入垂直标号") (setq modelss 0) (setq basepoint2 nil) ) (defun hors() (setvar "CMDECHO" 0) (princ "\n进入水平标号") (setq modelss 1) (setq basepoint2 nil) ) (defun oleader() (setvar "CMDECHO" 0) (princ "\n进入圆圈标号") (setq modelss 2) (setq basepoint2 nil) ) (defun fghj3() (setvar "CMDECHO" 0) (setq kkk basedx2 ) (if (null kkk8) (setq kkk8 10) ) (setq basedx2 (getdist "\n请输入横线长度<取消>:")) (if (null basedx2) (setq basedx2 kkk8) ) ) (defun vbnm() (setvar "CMDECHO" 0) (initget "b") (setq p1 (getkword "\n[B重设基准点]<取消>:")) (if (null P1) (setq basepoint2 basepoint2) (if (= p1 "b") (setq basepoint2 nil) ) ) ) (defun texthight() (setvar "CMDECHO" 0) (setq tthjlk (getreal "\n重设文本高度<取消>:")) (if (null tthjlk) (setq tthjlk cguvh) ) ) (defun reset2(/) (setvar "CMDECHO" 0) (setq text22 (getint "\n重设新号码<取消>:")) (if (null text22) (setq basetext2 basetext33) (setq basetext2 text22) ) ) (defun oleader22() (command "line" p1 ) (PRINC "\n请输入第二点:") (command pause "") (setq f1 (entlast)) (setq ppk (entget f1)) (setq xs2 (cadr (assoc 11 ppk))) (setq ys2 (caddr (assoc 11 ppk))) (setq str95 (getstring "\n请输入文本:")) (if (= (strlen str95) 1) (setq kkdm 2) (setq kkdm (strlen str95)) ) (setq ttnnss (* (sqrt (+ 1 (* kkdm kkdm 0.501))) tthjlk 0.5)) (command "erase" f1 "") (command "circle" (list xs2 ys2) ttnnss) (setq f1 (entlast)) (command "line" p1 (list xs2 ys2) "") (command "trim" f1 "" (list xs2 ys2) "") (setq f1 (entlast)) (setq ppk (entget f1)) (setq xs4 (cadr (assoc 11 ppk))) (setq ys4 (caddr (assoc 11 ppk))) (command "erase" f1 "") (setvar "ORTHOMODE" 0) (setvar "OSMODE" 0) (setvar "DIMASZ" (* 0.16 ssa)) (command "DIMLDRBLK" "dot" ) (VL-CMDF "leader" p1 (list xs4 ys4) "" "" "n") (command "DIMLDRBLK" cc ) (setvar "DIMASZ" ssa) (make_text2 xs2 ys2 10 tthjlk 5 str95) (princ) ) (defun make_text2(xm ym ww texth jss strs) (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setq tttwww (* (+ 2 (strlen strs)) (* 0.708 texth))) (setq strb "{\\f宋体|b0|i0|c134|p2;") (setq strc "}") (setq string2 (strcat strb strs strc)) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 "0") ;;;;; ----------------------------------------------图层名 (cons 100 "AcDbMText") (list 10 xm ym 0.0) (cons 40 texth) (cons 41 tttwww) (cons 71 jss) (cons 1 string2) ) ) ) (defun leader_h() (princ "\n零件标号 <水平标号>") (setq p1 "n") (while (or (= p1 "n") (= p1 "t") (= p1 "b")(= p1 "l")(= p1 "o")(= p1 "v")) (initget "n t b l o v") (setq p1 (getpoint "\n[重设号码N/字高T/基准点B/横线长度L/圆圈标号O/V垂直标号]请输入第一点:")) (cond ((= p1 "n") (reset2)) ((= p1 "v") (vors)) ((= p1 "b")(vbnm)) ((= p1 "t")(texthight)) ((= p1 "l")(fghj3)) ((= p1 "o")(oleader)) ) ) ) (defun leader_v() (princ "\n零件标号 <垂直标号>") (setq p1 "n") (while (or (= p1 "n") (= p1 "t") (= p1 "b")(= p1 "l")(= p1 "o")(= p1 "h")) (initget "n t b l o h") (setq p1 (getpoint "\n[重设号码N/字高T/基准点B/横线长度L/圆圈标号O/H水平标号]请输入第一点:")) (cond ((= p1 "n") (reset2)) ((= p1 "h") (hors)) ((= p1 "b")(vbnm)) ((= p1 "t")(texthight)) ((= p1 "l")(fghj3)) ((= p1 "o")(oleader)) ) ) ) (defun leader_o() (princ "\n零件标号 <圆圈标号>") (setq p1 "n") (while (or (= p1 "n") (= p1 "t") (= p1 "b")(= p1 "l")(= p1 "v")(= p1 "h")) (initget "n t b l v h") (setq p1 (getpoint "\n[重设号码N/字高T/基准点B/横线长度L/水平标号H/V垂直标号]请输入第一点:")) (cond ((= p1 "n") (reset2)) ((= p1 "h") (hors)) ((= p1 "b")(vbnm)) ((= p1 "t")(texthight)) ((= p1 "l")(fghj3)) ((= p1 "v") (vors)) ) ) ) (defun notext() (setq oo nil) (command "erase" LL1 ttm"") (setq r (* 0.4 hkgm)) (command "circle" p5 r) (ssadd (entlast) kkk) ) (defun ooo() (setq chsvn "3.2") (setq oo 0) ) (defun jjuu() (setq chsvn nil) (setq jkh 0) ) (defun jjyy() (setq jkh nil) (setq x6 (- x3 (* 3 tth))) (setq y6 (+ y3 (* 0.5 hkgm))) (make_text2 x6 y6 10 tth 5 "其余:") ) ;;;AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (defun FDd2000(/ e p pc k r n ep) (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (princ ) (setq e (car (entsel"\n局部放大\n此命令之前必须在要放大区域画一个圆\n请选择放大区域圆:")) pc (cdr (assoc 10(entget e))) p (getpoint "\n请输入放大后位置:") k (getreal "\n请输入放大倍数:") r (cdr (assoc 40 (entget e))) ) (setq kkk p) (command "copy" "cp" ) (setq n 0 ) (repeat 180 (command (polar pc (/ (* 2 n pi) 180) r)) (setq n (+ n 1)) ) (command """" pc p) (setq n 0) (setvar "

ICKBOX" 5) (command "zoom" "c" p (* 3 r)) (command "circle" p r) (setq ep (entlast)) (command "trim" ep "" ) (repeat 180 (command (polar p (/ (* 2 n pi)180) (* r 1.1))) (command "f" (polar p (/ (* 2 n pi) 180) (* r 1.01))) (setq n (+ n 1)) (command (polar p (/ (* 2 n pi) 180) (* r 1.01)) "") ) (command "" "zoom""p") (command "copyclip" "w" (list (- (car p) r) (- (cadr p) r)) (list (+ (car p) r)(+ (cadr p) r)) "") (command "erase""c"(list (- (car p) r) (- (cadr p) r)) (list (+ (car p) r)(+ (cadr p) r)) "") (command "pasteclip" (list (- (car p) r) (- (cadr p) r))) (command "scale""c"(list (- (car p) r) (- (cadr p) r)) (list (+ (car p) r)(+ (cadr p) r)) "" kkk k) (command "erase"ep"") (command "redraw") (princ) ) (defun FDd14(/ e p pc k r n ep) (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (princ ) (setq e (car (entsel"\n局部放大\n此命令之前必须在要放大区域画一个圆\n请选择放大区域圆:")) pc (cdr (assoc 10(entget e))) p (getpoint "\n请输入放大后位置:") k (getreal "\n请输入放大倍数:") r (cdr (assoc 40 (entget e))) ) (setq kkk p) (command "copy" "cp" ) (setq n 0 ) (repeat 180 (command (polar pc (/ (* 2 n pi) 180) r)) (setq n (+ n 1)) ) (command """" pc p) (setq n 0) (setvar "PICKBOX" 5) (command "zoom" "c" p (* 3 r)) (command "circle" p r) (setq ep (entlast)) (command "trim" ep "" ) (repeat 180 (command (polar p (/ (* 2 n pi)180) (* r 1.1))) (command "f" (polar p (/ (* 2 n pi) 180) (* r 1.01))) (setq n (+ n 1)) (command (polar p (/ (* 2 n pi) 180) (* r 1.01)) "") ) (command "" "zoom""p") (command "copyclip" "w" (list (- (car p) r) (- (cadr p) r)) (list (+ (car p) r)(+ (cadr p) r)) "") (command "erase""c"(list (- (car p) r) (- (cadr p) r)) (list (+ (car p) r)(+ (cadr p) r)) "") (command "pasteclip" (list (- (car p) r) (- (cadr p) r))"1" "1" "0") (command "scale""c"(list (- (car p) r) (- (cadr p) r)) (list (+ (car p) r)(+ (cadr p) r)) "" kkk k) (command "erase"ep"") (command "redraw") (princ) ) (defun c:dimqtol() (setvar "cmdecho" 0) (setq ann nil) (while (null ann) (setq arr nil) (while (null arr) (setq arr (entsel"\n请选择标注对象:")) ) (setq kkk (cdr(assoc 0 (entget (car arr))))) (if (= kkk "DIMENSION") (progn (setvar "DIMTFAC" 0.6) (setvar "DIMTOLJ" 1) (setvar "DIMTZIN" 8) (command "dimtol" "1") (command "dimtp") (princ "\n请输入上偏差:") (command pause) (command "dimtm") (princ "\n请输入下偏差:") (command pause) (command "dim" "update" arr "") (command) (command "dimtol" "0") (command "dimlim" "0") ) (setq arr nil) ) ) ) 制作明细表,其功能如下： 命令: _make_list 制作明细表 其它表格输出(F)/修改明细表格式(M)/编辑明细表(E)/绘制明细表(C)/明细表输出(O)/<明 细表输入>: *取消* ; 错误: 函数被取消 由于牵涉到外部文件，比较麻烦。下次再奉送给大家。 看看吧，会对你有用的。

hpy · 发表于 2004-5-18 18:47

好东西不少啊!谢谢!

koalabear · 发表于 2004-5-22 04:02

不错啊，希望斑竹早点把程序完善！

Smile · 发表于 2004-6-5 03:12

<

>支持！

dangxiao · 发表于 2004-6-5 18:18

老大程序不错，只是没注释，又后修改起来有点麻烦！

Michael_66 · 发表于 2004-6-12 19:51

好东西，这么久都没发现。谢谢提供。