Acad二次开发源程序大赠送：实用工具.doc

ACAD二次开发源程序大赠送实用工具 操作方法把下面的源程序copy到acad2000.lsp或acad2004.lsp文件的后面，保存。 重启动AutoCAD， OK 命令说明 partleader半自动零件标号、FDd局部放大、QCBH基准标号、cczp加工精度、qm qmh qmk画螺纹 dimqtol快速公差标注、Lineon和Lineoff视图投影画线。 Lineoff用法第二步画一条线与其它线相交，然后点选它们的交点。 可以把这些命令名改成你想要的命令名，只要不冲突 ;;;ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp defun cpartleader/ setar “ECHO“ 0 setar “ORTHOMODE“ 0 setar “OSMODE“ 0 if null modelss setq modelss 1 setq cc getar “DIMLDRBLK“ setq ssa getar “DIMASZ“ command “osmode“ “0“ if null basetext2 setq basetext2 1 if null tthjlk setq tthjlk getar “DIMTXT“ setq cguh tthjlk if null basedx2 setq basedx2 10 cond modelss 0leader_ modelss 1leader_h modelss 2 leader_o cond modelss 0model22 modelss 1model11 modelss 2 oleader22 ;;;kkkkkkkkkkkkkkkcfghfdgfdggggggggggggggggggggggddddddddddddddddd defun cFDd setq eracad atoi getar “ACADER“ if eracad 15 fdd2000 fdd14 defun cqm setar “echo“ 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 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 cqmh setar “echo“ 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 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 cqmk setar “echo“ 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 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 cQCBH setar “OSMODE“ 0 setar “ORTHOMODE“ 1 CNOW2 princ “\n基准标号“ if null hhtt setq hhtt getar “DIMTXT“ setq p3 “t“ while p3 “t“ initget “t“ setq p3 getpoint “\n 字高T/请输入基点“ if p3 “t“ setq hhtt getdist “\n请输入字高“ setq x3 car p3 setq y3 cadr p3 setq p1 list - x3 * 0.6 hhtt y3 setq p2 list x3 * 0.6 hhtt y3 setq p4 list x3 y3 * 0.43 hhtt setq p0 list x3 y3 * 1.2 hhtt setq y0 y3 * 1.2 hhtt setq kkk ssadd command “line“ p1 p2 ““ command ssadd entlast kkk command “line“ p3 p4 ““ command ssadd entlast kkk command “circle“ p0 * hhtt 0.77 command ssadd entlast kkk setq stre26 strcase getstring “\n请输入文本“ make_text2 x3 y0 10 hhtt 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 clineon/ SETAR “ECHO“ 0 SETAR “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 kkkcaddr kkk command “erase“ghk““ setar “OSMODE“ 0 command “line“ p0 setar “OSMODE“ 163 defun clineoff/ setar “echo“ 0 command “ORTHOMODE““1“ command “OsMODE““183“ command “line“pause pause pause““ command “undo“““ command “OsMODE““0“ command “line““0,0“ setar “OSMODE“ 163 ;;;yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy defun ccczp setar “OSMODE“ 640 setar “ORTHOMODE“ 0 setq p3 “t“ while or p3 ““ p3 “b“ p3 “n“ p3 “m“ p3 “t“ p3 “o“ p3 “j“ p3 “c“ initget “c b n m t o j“ setq p3 getpoint “\n [非加工O/其余J/字高T/固定文本12.5C/6.3/3.2B/1.6N/非固定文本M] 请输入基点“ cond p3 “c“ setq chsn “12.5“ p3 ““ setq chsn “6.3“ p3 “b“ setq chsn “3.2“ p3 “n“ setq chsn “1.6“ p3 “m“ setq chsn 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 getar “DIMTXT“ setq tth hhttk setq hkgm * 1.4 tth setq dx * hkgm / sin / pi 6cos / 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 setar “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 getar “DIMTXT“ setq tth hhttk setq y5 y1 * tth 0.741 if null chsn progn if null oldtext setq stre getstring “\n请输入文本“ setq stre getstring strcat “\n请输入文本“ if stre ““ setq stre oldtext setq stre chsn 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 setar “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 setar “ECHO“ 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 setar “ORTHOMODE“ 0 setar “OSMODE“ 0 setar “DIMASZ“ * 0.16 ssa command “DIMLDRBLK“ “dot“ command “leader“ p1 p2 p3 ““ ““ “n“ command “DIMLDRBLK“ cc setar “DIMASZ“ ssa SETQ KKK itoa basetext2 make_text2 x4 y4 10 tthjlk 5 KKK setq basetext2 basetext2 1 setq basetext33 basetext2 princ ;;ssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssss defun model22 setar “ECHO“ 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 setar “ORTHOMODE“ 0 setar “OSMODE“ 0 setar “DIMASZ“ * 0.16 ssa command “DIMLDRBLK“ “dot“ command “leader“ p1 p2 p3 ““ ““ “n“ command “DIMLDRBLK“ cc setar “DIMASZ“ ssa SETQ KKK itoa basetext2 make_text2 x4 y4 10 tthjlk 5 KKK setq basetext2 basetext2 1 setq basetext33 basetext2 princ defun pntoxls-allff1 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 “ECTORS“ 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 ors setar “ECHO“ 0 princ “\n进入垂直标号“ setq modelss 0 setq basepoint2 nil defun hors setar “ECHO“ 0 princ “\n进入水平标号“ setq modelss 1 setq basepoint2 nil defun oleader setar “ECHO“ 0 princ “\n进入圆圈标号“ setq modelss 2 setq basepoint2 nil defun fghj3 setar “ECHO“ 0 setq kkk basedx2 if null kkk8 setq kkk8 10 setq basedx2 getdist “\n请输入横线长度“ if null basedx2 setq basedx2 kkk8 defun bnm setar “ECHO“ 0 initget “b“ setq p1 getkword “\n[B重设基准点]“ if null P1 setq basepoint2 basepoint2 if p1 “b“ setq basepoint2 nil defun texthight setar “ECHO“ 0 setq tthjlk getreal “\n重设文本高度“ if null tthjlk setq tthjlk cguh defun reset2/ setar “ECHO“ 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 ““ setar “ORTHOMODE“ 0 setar “OSMODE“ 0 setar “DIMASZ“ * 0.16 ssa command “DIMLDRBLK“ “dot“ L-F “leader“ p1 list xs4 ys4 ““ ““ “n“ command “DIMLDRBLK“ cc setar “DIMASZ“ ssa make_text2 xs2 ys2 10 tthjlk 5 str95 princ defun make_text2xm ym ww texth jss strs setar “ECHO“ 0 setar “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 ““ initget “n t b l o “ setq p1 getpoint “\n[重设号码N/字高T/基准点B/横线长度L/圆圈标号O/垂直标号]请输入第一点“ cond p1 “n“ reset2 p1 ““ ors p1 “b“bnm p1 “t“texthight p1 “l“fghj3 p1 “o“oleader defun leader_ 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“bnm 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 ““ p1 “h“ initget “n t b l h“ setq p1 getpoint “\n[重设号码N/字高T/基准点B/横线长度L/水平标号H/垂直标号]请输入第一点“ cond p1 “n“ reset2 p1 “h“ hors p1 “b“bnm p1 “t“texthight p1 “l“fghj3 p1 ““ ors defun notext setq oo nil command “erase“ LL1 ttm““ setq r * 0.4 hkgm command “circle“ p5 r ssadd entlast kkk defun ooo setq chsn “3.2“ setq oo 0 defun jjuu setq chsn 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 “其余“ ;;;AAAAAAAAAAAAAAAAAAAAAA