專題-保護(hù)煤柱繪制軟件的開(kāi)發(fā)與應(yīng)用

專題部分保護(hù)煤柱繪制軟件的開(kāi)發(fā)與應(yīng)用摘要 本軟件基于Visual Basic 6.0并聯(lián)合Excel、Auto CAD開(kāi)發(fā)的繪制斜井井筒、立井井筒、急傾斜煤層群立井井筒、建筑物及工業(yè)廣場(chǎng)保護(hù)煤柱的圖形自動(dòng)化繪制軟件，并給予精確的定位，在礦井設(shè)計(jì)和改造中避免了煩瑣而復(fù)雜的工作，具有一定的實(shí)用性。關(guān)鍵詞：保護(hù)煤柱 CAD二次開(kāi)發(fā) VB Excel 自動(dòng)繪圖1.概述Mcrosoft公司的Visual Basic6.0是當(dāng)今最暢銷的編程語(yǔ)言之一，簡(jiǎn)單易學(xué)，功能強(qiáng)大，人機(jī)對(duì)話方便，程序運(yùn)行調(diào)試方便，得到了廣泛的應(yīng)用。Autodesk公司的AutoCAD是當(dāng)今世界上最暢銷的繪圖軟件之一，已成為廣大工程技術(shù)人員最好的設(shè)計(jì)助手。它具有強(qiáng)大的繪圖功能，同時(shí)，具有開(kāi)放性，用戶可以根據(jù)自己的實(shí)際需要及專業(yè)性質(zhì)，對(duì)CAD進(jìn)行二次開(kāi)發(fā)，從而更加完善地為本專業(yè)服務(wù)，這也是CAD受歡迎的重要原因之一。目前，計(jì)算機(jī)在采礦領(lǐng)域的應(yīng)用應(yīng)用已越來(lái)越廣，其中一個(gè)重要的應(yīng)用方向就是計(jì)算機(jī)輔助制圖（CAD）。在煤炭行業(yè)，CAD的應(yīng)用已相當(dāng)普遍，但制圖自動(dòng)化程度較低，工作量大，生產(chǎn)、設(shè)計(jì)單位也缺少這方面的軟件，由此給我們一個(gè)思路，通過(guò)編程實(shí)現(xiàn)繪圖的自動(dòng)化。CAD內(nèi)部的VBA開(kāi)發(fā)工具，使以上兩套功能強(qiáng)大的軟件可以無(wú)間隙地結(jié)合在一起，讓用戶可以自主開(kāi)發(fā)出專業(yè)方向軟件。為此采用AutoCAD的ActiveX技術(shù)及Visual Basic 6.0、Mcrosoft Excel編制軟件。2.原理2.1 地下開(kāi)采破壞了巖體內(nèi)部原有的力學(xué)平衡狀態(tài)，使上覆巖層不同程度地變形和破壞。當(dāng)開(kāi)采面積達(dá)到一定范圍之后，起始采場(chǎng)附近的巖層移動(dòng)和變形將擴(kuò)展到地表，此時(shí)的地表移動(dòng)和變形將影響到位于開(kāi)采影響范圍內(nèi)的房屋建筑、工程、河流、湖泊、鐵路及管線，會(huì)改變它們?cè)械臓顟B(tài)，甚至破壞。同樣，在移動(dòng)巖體內(nèi)的井巷也可能受到開(kāi)采影響而遭受破壞。當(dāng)?shù)叵麻_(kāi)采將影響到上覆巖層及地表，并且其產(chǎn)生的變形有可能危及巖體內(nèi)的井巷或者地表的建筑物和構(gòu)筑物正常使用時(shí)，最常用和最可靠的方法就是在需要保護(hù)的井筒、建筑物或構(gòu)筑物下方留一部分實(shí)體煤不采或暫時(shí)不采，所留煤柱的面積應(yīng)使周圍煤炭開(kāi)采時(shí)對(duì)保護(hù)對(duì)象不產(chǎn)生有危險(xiǎn)性的移動(dòng)和變形。為保護(hù)地貌、地面工業(yè)場(chǎng)地、地面建筑物、鐵路、堤壩等而留下來(lái)的實(shí)體煤稱為建筑物或構(gòu)筑物的保護(hù)煤柱。2.2 垂直剖面法設(shè)計(jì)保護(hù)煤柱原理垂直剖面法是作圖的方法，作沿煤層走向和傾向的剖面，在剖面圖上由移動(dòng)角確定煤住寬度，并投影到平面圖上，得到保護(hù)煤柱邊界。 作圖前所需的資料為： 松散層和基巖移動(dòng)角； 煤層底板等高線圖； 并田地質(zhì)剖面團(tuán)； 井上下對(duì)照?qǐng)D。 以圖1為例，說(shuō)明用垂直剖面法設(shè)計(jì)保護(hù)煤柱的步驟，圖中的煤層底板等高線標(biāo)高是為了說(shuō)明作圖方法所加的。圖1 垂直剖面法設(shè)計(jì)保護(hù)煤柱(1)在煤層底板等高線圖上，過(guò)要保護(hù)的建筑物或建筑物群最外角點(diǎn)，作平行于煤層走向和傾向的四條直線，交a、b、c和 d，形成矩形。 (2)按建筑物保護(hù)等級(jí)在矩形a、b、c和d四周加相應(yīng)寬度的圍護(hù)帶,形成地表保護(hù)范圍a、b、c、d，地表要保護(hù)范圍的邊界為mn和qk。 (3)過(guò)a、d或b、c中點(diǎn)，作沿煤層傾向的剖面II。 (4)將煤層底板等高線、上覆巖層和要保護(hù)的建筑物邊界投影到平行于煤層走向的垂面內(nèi)，形成所謂的投影面。 (5) I一I和面上，過(guò)m、n和q、k四點(diǎn)，按松散層移動(dòng)角劃線與基巖相交于、和、；在II剖面上，過(guò)和兩點(diǎn)，按下山移動(dòng)角和上山移動(dòng)角畫(huà)線與煤層交于和。 在剖面上，過(guò)和點(diǎn)按走向移動(dòng)角劃線，與煤層相交于與線同標(biāo)高的和，與同標(biāo)高的和。 (6)將和及、和投影到煤層底板等線圖上，得A、B、C、D四點(diǎn)，連接A、B、C和D，即得平面圖上的保護(hù)煤柱邊界。 在平面圖上用垂直剖面法設(shè)計(jì)的保護(hù)煤柱形狀是對(duì)稱的梯形，梯形的長(zhǎng)邊和短邊平行于煤層走向，因擴(kuò)大了地表保護(hù)范圍，在開(kāi)采影響下地表建筑物安全性較高。為了提高精度，在沿煤層傾向的剖面上，垂直剖面法所留的保護(hù)煤柱尺寸還可以由計(jì)算方法得到，計(jì)算結(jié)果如（1）式。 （式1）反斜井井筒及工業(yè)廣場(chǎng)保護(hù)煤柱繪制急傾斜煤層群立井井筒保護(hù)煤柱繪制立井井筒保護(hù)煤柱繪制2.3 立井井筒保護(hù)煤柱的設(shè)計(jì) 某礦立井井筒的地質(zhì)條件及沖積層和基巖移動(dòng)角值見(jiàn)表1。保護(hù)煤柱邊界的圈定如下(圖2)：圖2 立井井筒保護(hù)煤柱的圈定表1 某礦立井井筒地質(zhì)條件及沖積層和基巖移動(dòng)角值井筒垂深H（m）煤層厚度M（m）煤層傾角（）（）（）（）（）沖積層厚度h(m)3002204570607020(1)通過(guò)立井井筒中心沿煤層傾向和走向分別作剖面II和，按I級(jí)保護(hù)建筑物在井筒周圍留20m寬的圍護(hù)帶，在剖面圖上得m,n及k，l各點(diǎn)。 (2)根據(jù)沖積層和基巖的移動(dòng)角值，繪出保護(hù)煤柱的邊界線，在剖面II上得，點(diǎn)。在剖面上得，點(diǎn)。 (3)將、各點(diǎn)投影到平面圖上，得、點(diǎn)。過(guò)、點(diǎn)分別作走向平行線，井截取線段和分別等于和gh，得梯形。連接對(duì)角線O, O，O自O(shè)。 (4)以井簡(jiǎn)中心O為原點(diǎn)，分別以O(shè)、O、O、O為半徑畫(huà)圓弧，井交于對(duì)角線上；在對(duì)角線上取兩圓弧與之相交的中點(diǎn)，得P，Q，R，S。(5)用圓滑曲線連接、P、Q、R、S各點(diǎn)，即為立井井簡(jiǎn)保護(hù)煤柱的邊界。2.4 急傾斜煤層群立井井筒保護(hù)煤柱設(shè)計(jì)某礦開(kāi)采急傾斜煤層群，煤層傾角68，各煤層厚度及間距如圖4。立井井筒位于煤系地層底板，其參數(shù)為45，75，55。保護(hù)煤柱邊界圈定方法如下(圖3)： 圖3 急傾斜煤層群立井保護(hù)煤柱的圈定 (1)過(guò)工業(yè)場(chǎng)地角點(diǎn)作平行煤層走向和傾向的直線得四邊形1234。在四邊形外圍留20m寬圍護(hù)帶，得受護(hù)面積邊界1234。 (2)在過(guò)井筒中心的傾向剖面即A一B剖面上，過(guò)M點(diǎn)以45作直線，交基巖面上m點(diǎn)；由m點(diǎn)以55作直線，分別交和煤層于S和t點(diǎn)，則此兩點(diǎn)分別為兩個(gè)煤層的開(kāi)采下限。mst直線及礦井設(shè)計(jì)深度以內(nèi)所有煤層均為傾向剖面上的保護(hù)煤拄。(3)在過(guò)井筒中心的走向剖面即CD別面上，由P、Q兩點(diǎn)以45作直線，交于基巖面p、q點(diǎn)；由p、q兩點(diǎn)以78作直線，兩直線與設(shè)計(jì)深度所圈定的煤層，為走向剖面上的保護(hù)煤柱。(4)在平面圖上65為煤層保護(hù)煤柱邊界；87為煤層保護(hù)煤柱邊界pq910為煤層保護(hù)煤柱邊界，等等。2.5 反斜井井筒及工業(yè)場(chǎng)地保護(hù)煤柱設(shè)計(jì)某礦反斜井地質(zhì)條件及沖積層和基巖移動(dòng)角值如表2。保護(hù)煤柱邊界圈定方法如下(圖4)：表2 某礦反斜井井筒地質(zhì)條件和基巖移動(dòng)角值斜井斜長(zhǎng)L（m）斜井傾角（）煤層傾角（）煤層厚度M（m）沖積層厚度（m）()()()()41523112.21545757570圖4 反斜井井筒及工業(yè)場(chǎng)地保護(hù)煤柱的圈定(1)在工業(yè)場(chǎng)地邊界外側(cè)留15m寬的圍護(hù)帶；在斜井兩側(cè)留20m寬的圍護(hù)帶，得受護(hù)面積邊界。 （2)過(guò)斜井軸線作傾向剖面A一B。由工業(yè)場(chǎng)地受護(hù)邊界、點(diǎn)以45作直線與基巖面相交，由交點(diǎn)分別以75和70作直線，與煤層底板相交分別得、點(diǎn)。 煤層與井筒在e點(diǎn)相交。由并底車場(chǎng)巷道頂板到煤層底板的垂高不應(yīng)小于高度。30一30一25(m)。從而確定得煤層底板上的q點(diǎn)。 式中 30、25均為回歸的常數(shù)；為煤層傾角；為斜井落底處井底的曲線半徑。 井口在煤層上的垂直投影點(diǎn)為斜井井筒保護(hù)煤柱下邊界(當(dāng)只留斜井保護(hù)煤柱時(shí)，仍由井口受護(hù)面積邊界點(diǎn)按移動(dòng)角圈定)。 為傾向剖面上工業(yè)場(chǎng)地保護(hù)煤柱邊界。 為傾向剖面上斜井和井底車場(chǎng)保護(hù)煤柱邊界。 (3)在走向剖面CD上，由、點(diǎn)以45作直線與基巖面相交，由交點(diǎn)以75作直線，與傾向剖面上、點(diǎn)的投影線分別相交于點(diǎn)、，和、。和為走向剖面上工業(yè)廣場(chǎng)保護(hù)煤柱邊界。 斜井井筒受護(hù)面積邊界和傾向剖面上g、e點(diǎn)的投影線相交于點(diǎn)、和、。和，為走向剖面井底車場(chǎng)保護(hù)煤柱邊界。 由井口受護(hù)面積邊界以45作直線，與基巖面相交，由交點(diǎn)以75作直線，與傾向剖面上點(diǎn)的投影線分別相交于點(diǎn)、。連接和，與分別相交于點(diǎn)和。 (4)將、點(diǎn)投影到平面團(tuán)上，則即為反斜井及工業(yè)場(chǎng)地保護(hù)煤柱邊界。2.6 Visual Basic 與Auto CAD的連接Visual Basic語(yǔ)言對(duì)AutoCAD的二次開(kāi)發(fā)，就要使Visaul Basic的程序能調(diào)用CAD的命令并能在CAD的環(huán)境下由程序控制進(jìn)行自動(dòng)繪圖。首先在Visaul Basic模塊中申明一組對(duì)象。Public ACADApp As Object 定義AutoCAD對(duì)象Public AcadDoc As ObjectPublic AcadMds As ObjectPublic AcadUtil As ObjectPublic Sub QiDongCad() 連接CADOn Error Resume Next Set ACADApp = GetObject(, AutoCAD.AppliCAtion) If Err Then Err.Clear Set ACADApp = CreateObject(AutoCAD.AppliCAtion) End If Set AcadDoc = ACADApp.ActiveDocument Set AcadMds = AcadDoc.ModelSpace Set AcadUtil = AcadDoc.Utility Set AcadPaperSpace = AcadDoc.PaperSpace ACADApp.Visible = True2.7 Visual Basic與Excel的連接Visual Basic與Excel 的連接同Visual Basic與AutoCAD的連接，要使Visaul Basic的程序能調(diào)用Excel的命令、函數(shù)等，并在Excel中存取數(shù)據(jù)，首先要在Visaul Basic模塊中申明一組對(duì)象。Public ExcelApp As Object 定義EXCEL空間Public ExcelWBook As ObjectPublic ExcelWSheet As ObjectPublic ExcelShape As Excel.ShapesPublic ExcelChart As Excel.ChartPublic Excel_Name As StringPublic Paint_Name As StringPublic Sub QiDongExcel() 連接EXCEL On Error Resume Next 忽略錯(cuò)誤 Set ExcelApp = GetObject(, Excel.Application) 查找一個(gè)正在運(yùn)行的Excel 拷貝 If Err Then 如果 Excel 沒(méi)有運(yùn)行則運(yùn)行它 Err.Clear Set ExcelApp = CreateObject(Excel.Application) End IfEnd Sub2.8 自定義變量類型Public M(0 To 2) As DoublePublic N(0 To 2) As DoublePublic M1(0 To 2) As DoublePublic N1(0 To 2) As DoublePublic M2(0 To 2) As DoublePublic N2(0 To 2) As DoublePublic R(0 To 2) As DoublePublic l(0 To 2) As DoublePublic R1(0 To 2) As DoublePublic L1(0 To 2) As DoublePublic R2(0 To 2) As DoublePublic L2(0 To 2) As DoublePublic R3(0 To 2) As DoublePublic L3(0 To 2) As DoublePublic A(0 To 2) As DoublePublic B(0 To 2) As DoublePublic C(0 To 2) As DoublePublic D(0 To 2) As DoublePublic A1(0 To 2) As DoublePublic B1(0 To 2) As DoublePublic C1(0 To 2) As DoublePublic D1(0 To 2) As DoublePublic A2(0 To 2) As DoublePublic B2(0 To 2) As DoublePublic C2(0 To 2) As DoublePublic D2(0 To 2) As DoublePublic II1(0 To 2) As DoublePublic II2(0 To 2) As DoublePublic II3(0 To 2) As DoublePublic II4(0 To 2) As DoublePublic II5(0 To 2) As DoublePublic II6(0 To 2) As DoublePublic JiAo1 As DoublePublic JiAo2 As DoublePublic JiAo3 As DoublePublic JiAo4 As DoublePublic JiAo5 As DoublePublic BJiao1 As DoublePublic BJiao2 As DoublePublic BJiao3 As DoublePublic BJiao4 As DoublePublic BJiao5 As DoublePublic HouDu As DoublePublic H1 As DoublePublic H2 As DoublePublic HHY1 As DoublePublic HHY2 As DoublePublic MeiMiDu As Double2.9 畫(huà)圖過(guò)程3 使用說(shuō)明3.1運(yùn)行將文件“PillarDesign.exe”與含有其它6個(gè)程序的文件夾“app”放置在電腦同一地址下。雙擊“PillarDesign.exe”圖標(biāo)，出現(xiàn)運(yùn)行窗口(圖5)：圖5 PillarDesign軟件運(yùn)行界面點(diǎn)擊“進(jìn)入”，有一個(gè)兩秒鐘的提示頁(yè)面：圖6 提示頁(yè)面圖7 PillarDesign軟件運(yùn)行主界面此時(shí)點(diǎn)擊6個(gè)程序的任一按鈕，將調(diào)用出該程序的數(shù)據(jù)采集界面（圖8）：3.2 軟件使用圖8 數(shù)據(jù)采集頁(yè)面在各項(xiàng)文本框中輸入實(shí)際參數(shù)后，點(diǎn)擊“垂直剖面法繪制”按鈕，軟件將調(diào)用AutoCAD和Excel，實(shí)現(xiàn)自動(dòng)化繪圖和精確數(shù)據(jù)輸出（圖9，圖10，圖11）：圖9 AutoCAD繪制結(jié)果圖10 Excel運(yùn)行結(jié)果圖11 程序運(yùn)行成功提示3.3 退出軟件退出較簡(jiǎn)單，每一程序界面都有“退出”按鈕，點(diǎn)擊即可安全退出圖12 程序退出參 考 文 獻(xiàn)1 徐永忻.采礦學(xué).徐州：中國(guó)礦業(yè)大學(xué)出版社，20032 徐永忻.煤礦開(kāi)采學(xué).徐州：中國(guó)礦業(yè)大學(xué)出版社，19993 林在康、左秀峰.礦業(yè)信息及計(jì)算機(jī)應(yīng)用. 徐州：中國(guó)礦業(yè)大學(xué)出版社，20004 戴紹城.高產(chǎn)高效綜合機(jī)械化采煤技術(shù)與裝備.北京：煤炭工業(yè)出版社，19975 陳炎光、徐永祈.中國(guó)采煤方法.徐州：中國(guó)礦業(yè)大學(xué)出版社，19916 錢(qián)鳴高、劉聽(tīng)成.礦山壓力及控制. 北京：煤炭工業(yè)出版社，19917 于海勇.放頂煤開(kāi)采的基礎(chǔ)理論. 北京：煤炭工業(yè)出版社，19958 王省身.礦井災(zāi)害防治理論與技術(shù). 徐州：中國(guó)礦業(yè)大學(xué)出版社，19899 劉吉昌.煤礦施工設(shè)計(jì)基礎(chǔ).太原：山西人民出版社，198310 岑傳鴻.采場(chǎng)頂板控制與檢測(cè)技術(shù). 徐州：中國(guó)礦業(yè)大學(xué)出版社，199811 蔣國(guó)安、呂家立.采礦工程英語(yǔ). 徐州：中國(guó)礦業(yè)大學(xué)出版社，199812 李位民.特大型現(xiàn)代化礦井建設(shè)與工程實(shí)踐. 北京：煤炭工業(yè)出版社，200113 綜采設(shè)備管理手冊(cè)編委會(huì).綜采設(shè)備管理手冊(cè). 北京：煤炭工業(yè)出版社，199414 能源部.煤礦安全規(guī)程. 北京：煤炭工業(yè)出版社，199215 中國(guó)煤礦專用設(shè)備成套服務(wù)公司.采煤機(jī)械化成套設(shè)備參考手冊(cè).煤炭工業(yè)部. 北京：煤炭工業(yè)出版社，198416 劉吉昌.煤礦施工設(shè)計(jì)基礎(chǔ). 太原：山西人民出版社，198317 中國(guó)統(tǒng)配煤礦總公司物資供應(yīng)局.煤炭工業(yè)設(shè)備手冊(cè). 徐州：中國(guó)礦業(yè)大學(xué)出版社，199218 章玉華.技術(shù)經(jīng)濟(jì)學(xué). 徐州：中國(guó)礦業(yè)大學(xué)出版社，199519 綜采設(shè)備管理手冊(cè). 北京：煤炭工業(yè)出版社，1994附錄程序代碼：模塊中代碼Public M(0 To 2) As DoublePublic N(0 To 2) As DoublePublic M1(0 To 2) As DoublePublic N1(0 To 2) As DoublePublic M2(0 To 2) As DoublePublic N2(0 To 2) As DoublePublic R(0 To 2) As DoublePublic l(0 To 2) As DoublePublic R1(0 To 2) As DoublePublic L1(0 To 2) As DoublePublic R2(0 To 2) As DoublePublic L2(0 To 2) As DoublePublic R3(0 To 2) As DoublePublic L3(0 To 2) As DoublePublic A(0 To 2) As DoublePublic B(0 To 2) As DoublePublic C(0 To 2) As DoublePublic D(0 To 2) As DoublePublic A1(0 To 2) As DoublePublic B1(0 To 2) As DoublePublic C1(0 To 2) As DoublePublic D1(0 To 2) As DoublePublic A2(0 To 2) As DoublePublic B2(0 To 2) As DoublePublic C2(0 To 2) As DoublePublic D2(0 To 2) As DoublePublic II1(0 To 2) As DoublePublic II2(0 To 2) As DoublePublic II3(0 To 2) As DoublePublic II4(0 To 2) As DoublePublic II5(0 To 2) As DoublePublic II6(0 To 2) As DoublePublic JiAo1 As DoublePublic JiAo2 As DoublePublic JiAo3 As DoublePublic JiAo4 As DoublePublic JiAo5 As DoublePublic BJiao1 As DoublePublic BJiao2 As DoublePublic BJiao3 As DoublePublic BJiao4 As DoublePublic BJiao5 As DoublePublic HouDu As DoublePublic H1 As DoublePublic H2 As DoublePublic HHY1 As DoublePublic HHY2 As DoublePublic MeiMiDu As DoublePublic ACADApp As Object 定義AutoCAD對(duì)象Public AcadDoc As ObjectPublic AcadMds As ObjectPublic AcadUtil As Object Public WenZi As Object 定義圖層Public TianChong As ObjectPublic XiAnTiAo1 As ObjectPublic XiAnTiAo2 As ObjectPublic XiAnTiAo3 As ObjectPublic QiTA As ObjectPublic TuBiLi As DoublePublic TuMingCheng As StringPublic ExcelApp As Object 定義EXCEL空間Public ExcelWBook As ObjectPublic ExcelWSheet As ObjectPublic ExcelShape As Excel.ShapesPublic ExcelChart As Excel.ChartPublic Excel_Name As StringPublic Paint_Name As StringPublic Sub ExitCadExcel()Set ACADApp = NothingSet AcadDoc = NothingSet AcadMds = NothingSet AcadUtil = NothingSet AcadPaperSpace = Nothing Set WenZi = NothingSet TianChong = NothingSet XiAnTiAo1 = NothingSet XiAnTiAo2 = NothingSet XiAnTiAo3 = NothingSet QiTA = NothingSet ExcelApp = NothingEnd SubPublic Sub QiDongCad() 連接CADOn Error Resume Next Set ACADApp = GetObject(, AutoCAD.AppliCAtion) If Err Then Err.Clear Set ACADApp = CreateObject(AutoCAD.AppliCAtion) End If Set AcadDoc = ACADApp.ActiveDocument Set AcadMds = AcadDoc.ModelSpace Set AcadUtil = AcadDoc.Utility Set AcadPaperSpace = AcadDoc.PaperSpace ACADApp.Visible = True Set WenZi = AcadDoc.Layers.Add(文字) Set TianChong = AcadDoc.Layers.Add(填充) Set XiAnTiAo1 = AcadDoc.Layers.Add(實(shí)線) Set XiAnTiAo2 = AcadDoc.Layers.Add(虛線) Set XiAnTiAo3 = AcadDoc.Layers.Add(中心線) Set QiTA = AcadDoc.Layers.Add(其他) Dim SimFangTextStyle As Object Dim TimesTextStyle As Object Set SimFangTextStyle = AcadDoc.TextStyles.Add(SimFang) SimFangTextStyle.fontFile = C:WINDOWSFontsSimFang.ttf Set TimesTextStyle = AcadDoc.TextStyles.Add(Times) TimesTextStyle.fontFile = C:WINDOWSFontsTimes.ttf object.Load LineTypeName, FileName Dim LineTN As String Dim FileName As String FileName = App.Path & acadiso.lin LineTN = continuous ACADDoC.Linetypes.Load LineTN, FileName LineTN = ACAD_ISO02W100 AcadDoc.Linetypes.Load LineTN, FileName LineTN = ACAD_ISO04W100 AcadDoc.Linetypes.Load LineTN, FileNameEnd SubPublic Sub QiDongExcel() 連接EXCEL On Error Resume Next 忽略錯(cuò)誤 Set ExcelApp = GetObject(, Excel.Application) 查找一個(gè)正在運(yùn)行的 Excel 拷貝 If Err Then 如果 Excel 沒(méi)有運(yùn)行則 Err.Clear Set ExcelApp = CreateObject(Excel.Application) 運(yùn)行它 End IfEnd SubPublic Sub AddLineText(X1 As Double, Y1 As Double, _HHeight As Double, VHeight As Double, S As String, t As Boolean)Dim Point1(2) As DoubleDim Point2(2) As DoubleDim Point3(2) As DoubleDim Point4(2) As DoubleDim Point5(2) As DoublePoint1(0) = X1Point1(1) = Y1Point2(0) = X1 + HHeightPoint2(1) = Y1Point3(0) = Point2(0)Point3(1) = Y1 - VHeightPoint4(0) = Point1(0)Point4(1) = Point3(1)Point5(0) = (Point1(0) + Point2(0) / 2Point5(1) = (Point1(1) + Point3(1) / 2Dim LinObject As ObjectSet LinObject = AcadMds.AddLine(Point1, Point2)LinObject.Linetype = continuousLinObject.Layer = 實(shí)線Set LinObject = AcadMds.AddLine(Point2, Point3)LinObject.Linetype = continuousLinObject.Layer = 實(shí)線Set LinObject = AcadMds.AddLine(Point3, Point4)LinObject.Linetype = continuousLinObject.Layer = 實(shí)線Set LinObject = AcadMds.AddLine(Point4, Point1)LinObject.Linetype = continuousLinObject.Layer = 實(shí)線Dim ValText As DoubleIf t = True Then ValText = Val(S) ValText = ValText * 100 ValText = Fix(ValText) ValText = ValText / 100 S = Str(ValText)Else End IfDim TextHeight As DoubleTextHeight = VHeight * 0.5Set TextObj = AcadMds.AddText(S, Point5, TextHeight)TextObj.StyleName = TimesTextObj.HorizontalAlignment = acHorizontalAlignmentMiddleTextObj.TextAlignmentPoint = Point5End SubPublic Function WenBen2(Coner As Variant, widthw As Double, X As String, habcd As Double, SSX As Double, SSY As Double)Dim Corner1(0 To 2) As DoubleDim width As DoubleDim text As StringDim anObj As Object Corner1(0) = Coner(0) + SSX: Corner1(1) = Coner(1) + SSY: Corner1(2) = 0# width = widthw text = X Set anObj = AcadDoc.ModelSpace.AddMText(Corner1, width, text) anObj.Height = habcd anObj.StyleName = Times End FunctionPublic Sub ScaleEntityAllAcad(BiLi As Double)Dim SSetObj As AcadSelectionSetDim SSetObjName As StringSSetObjName = Time()Set SSetObj = AcadDoc.SelectionSets.Add(SSetObjName)SSetObj.Select acSelectionSetAllDim BasePoint(2) As DoubleBasePoint(0) = 0: BasePoint(1) = 0: BasePoint(2) = 0Dim ScaleFactor As DoubleScaleFactor = BiLiDim En