《金融帝國2》經(jīng)營管理指南介紹

;;此為樸英俊的lisp總匯(setvar"mirrtext"0);****************************************************************************;本段程序可將選中的圓一次性裁剪掉圓中（經(jīng)過圓心的）的線段。(Defunc:tc(/ucsflfillennmeedpt0ptpbx)(command"redraw")(command"undo""begin")(setqpbx(getvar"pickbox"))(setvar"pickbox"3)(setqucsfl(getvar"ucsfollow"))(setvar"ucsfollow"0)(command"ucs""world") ;轉(zhuǎn)到世界坐標(biāo)系(setqfil(ssget)) ；選擇圓(setqlen(sslengthfil)) ；確定選中圓的個數(shù)(setqn0)(while(<=n(-len1))(setqe(ssnamefiln))(setqed(entgete))(if(/="CIRCLE"(cdr(assoc0ed)))(setqn(+1n))(progn(setqpt0(cdr(assoc10ed))) ;oldcircle'scenter(command"zoom""c"pt0"80") ;可調(diào)整該數(shù)字以適應(yīng)不同半徑的圓(setqpt(osnappt0"nea"))(setqm1)(while(and(/=nilpt)(<m10));在一個圓內(nèi)裁剪不超過10次，以防止死循環(huán)(command"trim"e""pt"")(setqpt(osnappt0"nea"))(setqm(+1m)))(setqn(+1n))(command"zoom""p") )))(command"ucs""p") ;返回用戶坐標(biāo)系(setvar"ucsfollow"ucsfl)(setvar"pickbox"pbx)(command"undo""end")(princ))(princ"\n\n\t\ttcpiao\t\t\t裁剪圓內(nèi)通過圓心的直線\t\ttc");*********************************************************************************;本段程序可將選中的圓一次性轉(zhuǎn)為你所需要的半徑。(Defunc:cr(/ucsflRfillenneedbcR0pt0angpt1pt2lnlnnijjtqtkLpt)(command"redraw")(command"undo""begin")(setqpbx(getvar"pickbox"))(setvar"pickbox"3)(setqucsfl(getvar"ucsfollow"))(setvar"ucsfollow"0)(command"ucs""world") ;轉(zhuǎn)到世界坐標(biāo)系(setqR(getreal"\ninputR")) ；輸入圓半徑(setqfil(ssget)) ；選擇圓(setqlen(sslengthfil)) ；確定選中圓的個數(shù)(setqn0)(while(<=n(-len1))(progn(setqe(ssnamefiln))(setqed(entgete))(setqbnil)(setqcnil)(if(/="CIRCLE"(cdr(assoc0ed)))(setqn(+1n))(progn(setqR0(cdr(assoc40ed))) ;oldcircle'sradius(setqpt0(cdr(assoc10ed))) ;oldcircle'scenter(setqed(subst(cons40R)(assoc40ed)ed))(setqn(+1n))(entmoded)(command"zoom""c"pt0"15") ;可調(diào)整該數(shù)字以適應(yīng)不同半徑的圓(setqang0)(while(<ang(*2pi))(setqpt1(polarpt0angR0))(setqang(+ang(/pi30)))(setqpt2(osnappt1"endp"))(setqb(conspt2b)))(setqln(lengthb))(setqlnn(-ln1))(setqi0)(setqpt(nthib))(while(<=ilnn)(setqpt(nthib))(setqj(+i1))(setqjt(nthjb))(while(and(not(equalptjt))(<jlnn))(setqqt(nthjb))(setqj(+1j))(setqjt(nthjb)))(if(not(equalptjt))(setqc(consptc)))(setqi(+1i)))(setqk0)(setqL(lengthc));*************************************(while(<=k(-L1))(setqpt(nthkc))(if(>R0R)(command"extend"e""pt"")(command"trim"e""pt""))(setqk(+1k)))；while結(jié)束;*************************************(command"zoom""p")))))(command"ucs""p") ;返回用戶坐標(biāo)系(setvar"ucsfollow"ucsfl)(setvar"pickbox"pbx)(command"undo""end")(princ))(princ"\n\n\t\tcrpiao\t\t改變檢查井半徑的程序\t\t\tcr");*********************************************************************************;;;本文件與bgao.lsp相比，可在用戶坐標(biāo)系下標(biāo)示選取點(diǎn)的絕對坐標(biāo)。;技巧：（按一下F8鍵試試，你可能會有一點(diǎn)驚喜喲）;如果有什么BUG，請聯(lián)系我：piaoyj@;啟動命令為zb(defunc:zb(/ucsflosp0pxxpyypxpyppppppaapbbentlablesclenalphalfalfap1p2p3p11p22p21t1t2)(command"undo""begin")(setqCHO(getvar"CMDECHO")) ;CMDECHO系統(tǒng)變量為1時，當(dāng)使用command命令時反饋提示和輸入，如為0則不反饋(setvar"CMDECHO"0);(command"style""standard""txt,hztxt""""""""""""")(setqucsfl(getvar"ucsfollow"))(setvar"ucsfollow"0)(command"ucs""world") ;轉(zhuǎn)到世界坐標(biāo)系(setqos(getvar"osmode"))(while(equalhnil)(setqh(getreal"\n請輸入字體高度:"));(command"LAYER""Make""gaobz"""))(setvar"osmode"37) ;1端點(diǎn)，4圓心，32交點(diǎn)，可組合。(initget1"h")(setqp0(getpoint"\nH/<選擇插入點(diǎn):>"))(while(eqp0"h")(setqhh(getreal"\n請輸入字體高度:"))(if(/=nilhh)(setqhhh))(setqp0(getpoint"\n請選擇插入點(diǎn):")))(setqpxx(carp0))(setqpyy(nth1p0))(setqpx(rtospxx23))(setqpy(rtospyy23))(setvar"osmode"0)(setqpp(getpoint"\n請選擇引出點(diǎn):")) ;引出點(diǎn)pp(command"line"p0ppnill)(command"ucs""p") ;返回用戶坐標(biāo)系(command"line"""pause"")(setqentl(entget(entlast)))(setqa(assoc10entl))(setqb(assoc11entl))(setqpa(cdra)) ;引出點(diǎn)pa(setqppp(cdrb)) ;引出點(diǎn)pb(setqpaa(transpa01))(setqpbb(transppp01)) ;引出點(diǎn)的用戶坐標(biāo)(setqle(distancepaapbb)) ;兩點(diǎn)間距離 (setqlen(*9.5h))(setqsc(/lenle))(if(<lelen)(progn(command"scale"(entlast)""paasc"")))(setqalph(anglepaapbb)) ;引出兩點(diǎn)的弧度alph(setqalf(*180.0(/alphpi))) ;求出角度值alf(setqp1(polarpaaalphh)) (setqp2(polarp1alph(*7h))) ;p2決定線長(setqp3(polarp2alph1000))(setqent(entlast))(command"break"entp2p3) ;將多余的線剪掉(if(>=alf105)(if(>=alf255)(progn(setqpdp1)(setqalfaalf)(setqp11(polarpd(+1.5708alph)(*0.4h)))(setqp12(polarpd(+4.7124alph)(*1.4h)));定出文本起點(diǎn))(progn(setqp21(polarp2(+pialph)h)) ;(setqp11(polarp21(-alph1.5708)(*0.4h)))(setqp12(polarp21(+alph1.5708)(*1.4h)));定出文本起點(diǎn)(setqalfa(+alf180)))) ;當(dāng)alf大于105時(progn(setqpdp1)(setqalfaalf)(setqp11(polarpd(+1.5708alph)(*0.4h)))(setqp12(polarpd(+4.7124alph)(*1.4h)));定出文本起點(diǎn)))(setqt1(strcat"X-"py))(setqt2(strcat"Y-"px))(command"text"p11halfat1)(command"text"p12halfat2)(setvar"osmode"os) ;返回原捕捉模式(setvar"ucsfollow"ucsfl)(command"undo""end")(setvar"CMDECHO"CHO)(princ))(princ"\n\n\t\tzbpyj\t\t\t標(biāo)注坐標(biāo)的程序\t\t\tzb");*********************************************************************************(defunc:pg()(command"purge""a""""n")(command"purge""a""""n")(command"purge""a""""n"))(princ"\n\n\t\tauto-purge\t\tpurge的批處理命令\t\t\tpg");*********************************************************************************(Defunc:et(/newtxv1v2nmeoldtxv3)(setvar"cmdecho"0)(prompt"\npicktexttobechanged:")(setqv1(ssget))(setqnewtx(getstringT"\nENTERNEWSTRING:"))(setqnewtx(cons1newtx))(setqv20)(if(/=v1nil)(while(<v2(sslengthv1))(setqnme(ssnamev1v2))(setqoldtx(assoc1(entgetnme)))(setqv3(entgetnme))(entmod(substnewtxoldtxv3))(entupdnme)(setqv2(+v21)))))(princ"\n\n\t\tet\t\t\t以指定內(nèi)容替代所選的文本\t\tet");*********************************************************************************(Defunc:at(/txtnewv1v2)(command"redraw")(setvar"cmdecho"0)(prompt"\npicktexttobechanged:")(setqv1(ssget))(setqaddtr(getstringT"\nENTERNEWSTRINGTOADD:"))(setqv20)(if(/=v1nil)(while(<v2(sslengthv1))(setqnme(ssnamev1v2))(if(="TEXT"(cdr(assoc0(entgetnme))))(progn(setqoldtx(assoc1(entgetnme)))(setqoldtr(cdroldtx))(setqnewtr(strcataddtroldtr))(setqnewtx(cons1newtr))(setqv3(entgetnme))(entmod(substnewtxoldtxv3))(entupdnme)(setqv2(+v21)))(setqv2(+v21)))))(princ))(princ"\n\n\t\tat\t\t\t將指定內(nèi)容增加到所選的文本之前\t\tat");*********************************************************************************;技巧：（按一下F8鍵試試，你可能會有一點(diǎn)驚喜喲）;如果有什么BUG，請聯(lián)系我：piaoyj@;啟動命令為bz(defunc:bz(/CHOosp0pxxpyypxpyppentlabpappppaapbblelenscalphalfp1p2p3entpdp11p12p21)(command"undo""begin")(setqCHO(getvar"CMDECHO"))(setvar"CMDECHO"0);(command"style""txtp""txt,hztxt""""""""""""")(while(equalh1nil)(setqh1(getreal"\n請輸入字體高度:"));(command"LAYER""Make""gaobz"""))(setqos(getvar"osmode"))(setvar"osmode"4) ;捕捉方式原37(setqom(getvar"orthomode"))(setvar"orthomode"1)(setqp0(getpoint"\n請選擇插入點(diǎn):"))(setqpxx(carp0))(setqpyy(nth1p0))(setqpx(rtospxx23))(setqpy(rtospyy23))(setvar"osmode"0)(setqpp(getpoint"\n請選擇引出點(diǎn):")) ;引出點(diǎn)pp(command"line"p0ppnill)(command"line"""pause"")(setqentl(entget(entlast)))(setqa(assoc10entl))(setqb(assoc11entl))(setqpa(cdra)) ;引出點(diǎn)pa(setqppp(cdrb)) ;引出點(diǎn)pb(setqpaa(transpa01))(setqpbb(transppp01)) ;引出點(diǎn)的用戶坐標(biāo)(setqle(distancepaapbb)) ;兩點(diǎn)間距離 (setqlen(*4.3h1))(setqsc(/lenle))(if(<lelen)(progn(command"scale"(entlast)""paasc"")))(setqalph(anglepaapbb)) ;引出兩點(diǎn)的弧度alph(setqalf(*180.0(/alphpi))) ;求出角度值alf(setqp1(polarpaaalph(*0.4h1))) (setqp2(polarp1alph(*3.5h1)))(setqp3(polarp2alph1000))(setqent(entlast))(command"break"entp2p3) ;將多余的線剪掉(if(>=alf105)(if(>=alf255)(progn(setqpdp1)(setqalfaalf)(setqp11(polarpd(+1.5708alph)(*0.3h1)))(setqp12(polarpd(+4.7124alph)(*1.3h1)));定出文本起點(diǎn))(progn(setqp21(polarp2(+pialph)(*0.5h1))) ;(*0.5h1)調(diào)節(jié)向左標(biāo)注時的文本起點(diǎn)(setqp11(polarp21(-alph1.5708)(*0.3h1)))(setqp12(polarp21(+alph1.5708)(*1.3h1)));定出文本起點(diǎn)(setqalfa(+alf180)))) ;當(dāng)alf大于105時(progn(setqpdp1)(setqalfaalf)(setqp11(polarpd(+1.5708alph)(*0.3h1)))(setqp12(polarpd(+4.7124alph)(*1.3h1)));定出文本起點(diǎn)))(command"text"p11h1alfa"DADA")(command"text"p12h1alfa"ADAD")(setvar"osmode"os) ;返回原捕捉模式(setvar"orthomode"om) ;返回原正交模式(command"undo""end")(setvar"CMDECHO"CHO)(princ))(princ"\n\n\t\tbzpyj\t\t\t幫助標(biāo)注檢查井標(biāo)高的工具\(yùn)t\tbz");*********************************************************************************;authorpiaoyingjunpiaoyj@(Defunc:cb(/filscscllenneedh)(command"redraw")(setqfil(ssget))(setqsc(getreal"\n請輸入寬度比例："))(setqsclsc)(setqlen(sslengthfil))(setqn0)(while(<=n(-len1))(progn(setqe(ssnamefiln))(if(="TEXT"(cdr(assoc0(setqed(entgete)))))(progn(setqhscl)(setqed(subst(cons41h)(assoc41ed)ed))(setqn(+1n))(entmoded))(setqn(+1n)))))(princ))(princ)(princ"\n\n\t\t改字體寬度比例cb\t改變所選文本的寬度比例\t\tcb");*********************************************************************************;authorpiaoyingjunpiaoyj@(Defunc:cs(/fillenneh_oldh_newsc)(command"redraw")(setqfil(ssget))(setqsc(getreal"\n請輸入放大倍數(shù)："))(setqlen(sslengthfil))(setqn0)(while(<=n(-len1))(progn(setqe(ssnamefiln))(if(="TEXT"(cdr(assoc0(setqed(entgete)))))(progn(setqh_old(cdr(assoc40ed)))(setqh_new(*sch_old))(setqed(subst(cons40h_new)(assoc40ed)ed))(setqn(+1n))(entmoded))(setqn(+1n)))))(princ))(princ)(princ"\n\n\t\t將所選文本放大/縮小n倍,\t\tcs");*********************************************************************************;;;peditn.lsp;;;(C)給排水組;;;byzhuxiaofeng;;;1995,10,20(1版);;;1997,5,15(2版);;;2001,8,15(3版)bypiaoyingjun;;;該程序可修改線,弧,圓、橢圓及多義線的寬度(defunC:pn(/plneqwamlayer0color0linetype0layer1color1linetype1rad-outrad-in)(command"undo""begin")(setqoldblp(getvar"blipmode")oldech(getvar"cmdecho")olderr*error*linetype1(getvar"celtype")layer1(getvar"clayer")color1(getvar"cecolor"))(setvar"blipmode"0)(setvar"cmdecho"0)(defun*error*(msg)(princ"\n")(princmsg)(setvar"blipmode"oldblp)(setvar"cmdecho"oldech)(setq*error*olderr)(princ))(prompt"\n請選擇要改變寬度的線,弧,圓及多義線.")(setqp(ssget))(setqw(getreal"\n請輸入寬度<1>:"))(if(notw)(setqw1))(setql0m0n(sslengthp))(while(<ln)(setqq(ssnamepl))(setqent(entgetq))(setqb(cdr(assoc0ent)))(if(memberb'("LINE""ARC"))(progn(command"PEDIT"q"y""w"w"x")(setqm(+1m))))(if(="LWPOLYLINE"b)(progn(command"PEDIT"q"w"w"x")(setqm(+1m))))(if(="CIRCLE"b)(progn(if(assoc6ent)(setqlinetype0(cdr(assoc6ent)))(setqlinetype0"bylayer"))(setqlayer0(cdr(assoc8ent)))(if(assoc62ent)(setqcolor0(cdr(assoc62ent)))(setqcolor0"bylayer"))(setqcenter0(cdr(assoc10ent)))(setqradius0(cdr(assoc40ent)))(setqdiameter0(*2radius0))(entdelq)(command"color"color0)(command"layer""s"layer0"")(command"linetype""s"linetype0"")(if(>wdiameter0)(progn(princ"\n\t因線寬大于圓的直徑，故將該圓填充")(princ)(setqrad-out(*2radius0)rad-in0)))(if(<=wdiameter0)(progn(setqrad-out(+(*2radius0)w)rad-in(-(*2radius0)w))))(command"donut"rad-inrad-outcenter0"")(setqm(+1m))))(setql(+1l)))(if(="ELLIPSE"b)(progn(setqcenter0(cdr(assoc10ent)))(command"offset"wqcenter0"")(command"offset"wq(list000)"")(entdelq)(command"hatch""s""f"center0(list000)"""")))(if(=0m)(progn(princ"\n\t沒有任何線,弧,圓，橢圓，及多義線被選中")(princ)))(setvar"blipmode"oldblp)(setvar"cmdecho"oldech)(setq*error*olderr)(command"color"color1)(command"layer""s"layer1"")(command"linetype""s"linetype1"")(command"undo""end")(princ)(princ"\n\t線寬編輯程序,(c)1997")(princ"\n\tc:Peditn已加載;以Pn啟動命令.\n")(princ))(princ"\n\n\t\t線寬編輯程序\t\t可改變線、圓、橢圓、弧及多義線的寬度\tpn");*********************************************************************************;authorpiaoyingjunpiaoyj@(Defunc:cz(/fillenneedbnew1cnew2)(command"redraw")(setqfil(ssget))(setqlen(sslengthfil))(setqn0)(while(<=n(-len1))(progn(setqe(ssnamefiln))(setqed(entgete))(if(/=nil)(progn(setqb(assoc10ed))(setqnew1(list10(car(cdrb))(car(cdr(cdrb)))0))(setqed(substnew1bed))(setqc(assoc11ed))(setqnew2(list11(car(cdrc))(car(cdr(cdrc)))0))(setqed(substnew2ced))(setqn(+1n))(entmoded))(setqn(+1n)))))(princ));(princ"\n\t改變縱坐標(biāo),(piaoyj@)2001");(princ"\n\t程序已加載;以cz啟動命令.\n")(princ)(princ"\n\n\t\t改直線縱坐標(biāo)cz\t改變簡單實(shí)體（非多義線）的縱坐標(biāo)為0cz");*********************************************************************************(defunc:xs(/eed)(setqe(car(entsel)))(textscr)(setqed(entgete)));(princ"\n\t顯示所選實(shí)體的信息");(princ"\n\t程序已加載，以xs啟動命令。\n")(princ)(princ"\n\n\t\t顯示實(shí)體信息xs\t顯示所選的實(shí)體的信息\t\txs");*********************************************************************************;authorpiaoyingjunpiaoyj@(Defunc:cdx(/case)(command"redraw")(setqfil(ssget))(setqcase(getint"\n改成(1)小寫/<直接回車為大寫>：")) (setqlen(sslengthfil))(setqn0)(while(<=n(-len1))(progn(setqe(ssnamefiln))(cond((="TEXT"(cdr(assoc0(setqed(entgete)))))(progn(setqostr(cdr(assoc1ed)))(setqnstr(strcaseostrcase))(setqed(subst(cons1nstr)(assoc1ed)ed))(setqn(+1n))(entmoded)))((="MTEXT"(cdr(assoc0(setqed(entgete)))))(progn(setqostr(cdr(assoc1ed)))(setqnstr(strcaseostrcase))(setqlenstr(strlennstr))(setqm1)(while(<mlenstr)(if(="\\p"(substrnstrm2))(setqnstr(strcat(substrnstr1m)"\P"(substrnstr(+2m))));(setqm(+1m)))(setqm(+1m)))(setqed(subst(cons1nstr)(assoc1ed)ed))(setqn(+1n))(entmoded)))(T(setqn(+1n))))))(princ))(princ"\n\t\t改變所選文本的大小寫以cdx啟動命令2002\n");*********************************************************************************(Defunc:ti(/tn) ;圖形空間和模型空間的轉(zhuǎn)換(setqtn(getvar"tilemode"))(if(=tn1)(setvar"tilemode"0)(setvar"tilemode"1))(princ));*********************************************************************************;本段程序幫你統(tǒng)計給水管道管長工程量。但前提是格式為“(DN***L=**);如果有什么BUG，請聯(lián)系我：piaoyj@;authorpiaoyingjunpiaoyj@(Defunc:tgs(/sumsmsumstsc1scfilneedetjtzhlenln)(command"redraw")(setqsum0)(setqsm0)(setqsumst0)(setqfil(ssget))(setqsc1(getstring"\n請輸入需要統(tǒng)計的管徑(DN***):\n"))(setqsc(strcasesc1))(setqlen(sslengthfil))(setqn0)(while(<=n(-len1)) ;1(progn ;2(setqe(ssnamefiln))(if(="TEXT"(cdr(assoc0(setqed(entgete))))) ;3(progn ;4(setqet(cdr(assoc1(setqed(entgete)))));********(setqln(strlenet))(setqj1)(while(<jln) ;5(if(or(/=sc(substret1j))(="0"(substret(+1j)1))) ;6(setqj(+1j))(progn(setqi1) ;7(while(<iln) ;8截取單管管長(setqtzh(substreti2))(if(=tzh"L=")(progn(setqsm(substret(+i2)))(setqsum(+sum(atofsm))))) (setqi(+1i))) ;接8(setqj(+1j)))