《CADVBA初級(jí)教程(全).doc》由會(huì)員分享，可在線閱讀，更多相關(guān)《CADVBA初級(jí)教程(全).doc（15頁(yè)珍藏版）》請(qǐng)?jiān)谘b配圖網(wǎng)上搜索。

第一課：入門 1.為什么要寫這個(gè)教程 市面上ACAD VBA 的書不多，它的幫助是英文版的，很多人看不懂。其實(shí)我轉(zhuǎn)行已經(jīng)好幾年了，而且手藝也 慢慢生疏了，寫個(gè)教程對(duì)自己來說也是一次復(fù)習(xí)。 2.什么是Autocad VBA？ VBA 是Visual Basic for Applications 的英文縮寫，它是一個(gè)功能強(qiáng)大的開發(fā)工具，學(xué)好VBA 可以成倍 甚至成百、成萬倍提高工作效率，在工作中，有很多任務(wù)僅用ACAD 命令不可能完成的，只要學(xué)好VBA 就可 以做到，相信到時(shí)候您一定會(huì)得到同事的佩服、老板的器重。 3、VBA 有多難？ 相信大家都知道Basic 是的含義。應(yīng)該承認(rèn)，我的水平還不高，錯(cuò)誤之處在所難免，如果大家發(fā)現(xiàn)錯(cuò)誤一 定要提出批評(píng)，以便及時(shí)更正。 4、怎樣學(xué)習(xí)VBA？ 介紹大家一個(gè)學(xué)習(xí)公式：信心+恒心=開心。仔細(xì)閱讀本教程，完成例題，在學(xué)習(xí)的過程中一定要多思考， 多想一些是什么、為什么。本教程將陸續(xù)發(fā)布在CAD 世界論壇上，您不需要付費(fèi)就可以學(xué)習(xí)。本作者在此 鄭重承諾：關(guān)于本教程中有任何疑問，可以跟貼提問，只要有時(shí)間，本人一定會(huì)耐心解答。我不會(huì)發(fā)到任 何人的郵箱中，您自己在論壇上找就可以了，請(qǐng)不要再向我索要這份教程。 5、現(xiàn)在我們開始編寫第一個(gè)程序：畫一百個(gè)同心圓 第一步：復(fù)制下面的紅色代碼 第二步：在模型空間按快捷鍵Alt+F8，出現(xiàn)宏窗口 第三步：在宏名稱中填寫C100，點(diǎn)“創(chuàng)建”、“確定” 第四步：在Sub c100()和End Sub 之間粘貼代碼 第五步：回到模型空間，再次按Alt+F8，點(diǎn)擊“運(yùn)行” Sub c100() Dim cc(0 To 2) As Double 聲明坐標(biāo)變量 cc(0) = 1000 定義圓心座標(biāo) cc(1) = 1000 cc(2) = 0 For i = 1 To 1000 Step 10 開始循環(huán) Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) 畫圓 Next i End Sub 也許您還看不懂上面的代碼，這沒有關(guān)系，只要能把同心畫出來就可以了，祝您成功。 第二課編程基礎(chǔ) 本課主要任務(wù)是對(duì)上一課的例程進(jìn)行詳細(xì)分析 下面是源碼： Sub c100() Dim cc(0 To 2) As Double 聲明坐標(biāo)變量 cc(0) = 1000 定義圓心座標(biāo) cc(1) = 1000 cc(2) = 0 For i = 1 To 1000 Step 10 開始循環(huán) Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) 畫圓 Next i End Sub 先看第一行和最后一行： Sub C100() …… End Sub C100 是宏的名稱，也叫過程名稱，當(dāng)用戶執(zhí)行C100 時(shí)程序?qū)⑦\(yùn)行sub 和end sub 之間的所有指令。 第二行： Dim cc(0 To 2) As Double 聲明坐標(biāo)變量 后半段“聲明坐標(biāo)變量”自動(dòng)變?yōu)榫G色字體，它是代碼語句的注釋，它不會(huì)影響程序運(yùn)行，它的作用是告 訴閱讀者程序員的想法。對(duì)于簡(jiǎn)單的程序，一般不需要寫注釋，如果要編寫非常復(fù)雜的程序，最好要多加 注釋，越詳細(xì)越好，對(duì)于程序員來說，這是一個(gè)好習(xí)慣。 電腦真正編譯執(zhí)行的是這條語句：Dim cc(0 To 2) As Double 它的作用就是聲明變量。 Dim 是一條語句，可以理解為計(jì)算機(jī)指令。 它的語法：Dim 變量名As 數(shù)據(jù)類型 本例中變量名為CC，而括號(hào)中的0 to 2 聲明這個(gè)CC 是一個(gè)數(shù)組，這個(gè)數(shù)組有三個(gè)元素：CC(0)、CC(1)、 CC(2)，如果改為CC(1 to 3)，則三個(gè)元素是CC(1)、CC(2)、CC(3)，有了這個(gè)數(shù)組，就可以把坐標(biāo)數(shù)值放 到這個(gè)變量之中。 Double 是數(shù)據(jù)類型中的一種。ACAD 中一般需要定義坐標(biāo)時(shí)就用這個(gè)數(shù)據(jù)類型。在ACAD 中數(shù)據(jù)類型的有很 多，下面兩個(gè)是比較常用的數(shù)據(jù)類型，初學(xué)者要有所理解。 Long（長(zhǎng)整型），其范圍從-2,147,483,648 到2,147,483,647。 Variant 它是那些沒被顯式聲明為其他類型變量的數(shù)據(jù)類型，可以理解為一種通用的數(shù)據(jù)類型，這是最常 用的。 下面三條語句 cc(0) = 1000 定義圓心座標(biāo) cc(1) = 1000 cc(2) = 0 它們的作用是給CC 變量的每一個(gè)元素賦,值其順序是X、Y、Z 坐標(biāo)。 For i = 1 To 1000 Step 10 開始循環(huán) …… Next i 結(jié)束循環(huán) 這兩條語句的作用是循環(huán)運(yùn)行指令，每循環(huán)一次，i 值要增加10，當(dāng)i 加到1000 時(shí)，結(jié)束循環(huán)。 i 也是一個(gè)變量，雖然沒有聲明i 變量，程序還是認(rèn)可的，VB 不是C 語言，每用一個(gè)變量都要聲明，不聲 明就會(huì)報(bào)錯(cuò)。簡(jiǎn)單是簡(jiǎn)單了，這樣做也有壞處，如果不小心打錯(cuò)了一個(gè)字母，程序不會(huì)報(bào)錯(cuò)，如果程序很 長(zhǎng)，那就會(huì)出現(xiàn)一些意想不到的錯(cuò)誤。 step 后面的數(shù)值就是每次循環(huán)時(shí)增加的數(shù)值，step 后也可以用負(fù)值。 例如：For i =1000 To 1 Step -10 很多情況下，后面可以不加step 10 如：For i=1 to 100，它的作用是每循環(huán)一次i 值就增加1 Next i 語句必須出現(xiàn)在需要結(jié)束循環(huán)的位置，不然程序沒法運(yùn)行。 下面看畫圓命令： Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) Call 語句的作用是調(diào)用其他過程或者方法。 ThisDrawing.ModelSpace 是指當(dāng)前CAD 文檔的模型空間 AddCircle 是畫圓方法 Addcicle 方法需要兩個(gè)參數(shù)：圓心和半徑 CC 就是圓心坐標(biāo)，i*10 就是圓的半徑，本例中，這些圓的半徑分別是10、110、210、310…… 本課到此結(jié)束，下面請(qǐng)完成一道思考題： 1. 以(4,2)為圓心，畫5 個(gè)A utocad VBA 初級(jí)教程 (第三課編程基礎(chǔ)二) 有一位叫自然9172 的網(wǎng)友提出了下面的問題： 繪制三維多段線時(shí)X、Y 值在屏幕上用鼠標(biāo)選取，Z 值用鍵盤輸入 本課將講解這個(gè)問題。 為了簡(jiǎn)化程序，這里用多條直線來代替多段線。以下是源碼： Sub myl() Dim p1 As Variant 申明端點(diǎn)坐標(biāo) Dim p2 As Variant p1 = ThisDrawing.Utility.GetPoint(, "輸入點(diǎn):") 獲取點(diǎn)坐標(biāo) z = ThisDrawing.Utility.GetReal("Z 坐標(biāo):") 用戶輸入Z 坐標(biāo)值 p1(2) = z 將Z 坐標(biāo)值賦予點(diǎn)坐標(biāo)中 On Error GoTo Err_Control 出錯(cuò)陷井 Do 開始循環(huán) p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "輸入下一點(diǎn):") 獲取下一個(gè)點(diǎn)的坐標(biāo) z = ThisDrawing.Utility.GetReal("Z 坐標(biāo):") 用戶輸入Z 坐標(biāo)值 p2(2) = z 將Z 坐標(biāo)值賦予點(diǎn)坐標(biāo)中 Call ThisDrawing.ModelSpace.AddLine(p1, p2) 畫直線 p1 = p2 將第二點(diǎn)的端點(diǎn)保存為下一條直線的第一個(gè)端點(diǎn)坐標(biāo) Loop Err_Control: End Sub 先談一下本程序的設(shè)計(jì)思路： 1、獲取第一點(diǎn)坐標(biāo) 2、輸入第一點(diǎn)Z 坐標(biāo) 3、獲取第二點(diǎn)坐標(biāo) 4、輸入第二點(diǎn)Z 坐標(biāo) 5、以第一、二點(diǎn)為端點(diǎn)，畫直線 6、下一條線的第一點(diǎn)=這條線的第二點(diǎn) 7、回到第3 步進(jìn)行循環(huán) 如果用戶沒有輸入坐標(biāo)或Z 值，則程序結(jié)束。 首先看以下兩條語句： p1 = ThisDrawing.Utility.GetPoint(, "輸入點(diǎn):") ‘獲取點(diǎn)坐標(biāo) …… p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "輸入下一點(diǎn):") 獲取下一個(gè)點(diǎn)的坐標(biāo) 這兩條語句的作用是由用戶輸入點(diǎn)用鼠標(biāo)選取點(diǎn)坐標(biāo)，并把坐標(biāo)值賦給p1、p2 兩個(gè)變量。 ThisDrawing.Utility.GetPoint（）在ACAD 中這是最常用的方法之一，它需要兩個(gè)參數(shù)，在逗號(hào)前面的參 數(shù)應(yīng)該是一個(gè)點(diǎn)坐標(biāo)，它的作用是在屏幕上畫一條線，前一個(gè)端點(diǎn)位于點(diǎn)坐標(biāo)位置，后一個(gè)端點(diǎn)跟隨鼠標(biāo) 移動(dòng)，逗號(hào)之前可以什么都不填，這時(shí)沒有線條會(huì)跟隨鼠標(biāo)移動(dòng)，但逗號(hào)必須保留。 逗號(hào)后面使用一串字符，程序在命令行顯示這串字符，這不難理解。 VbCr 通常代表一個(gè)回車符，而在這個(gè)語句中，它的作用是在命令行不顯示“命令：” &的作用是連接字符。舉例： “愛我中華”&”抵制日貨”&”從我做起” z = ThisDrawing.Utility.GetReal("Z 坐標(biāo):") 用戶輸入Z 坐標(biāo)值 由用戶輸入一個(gè)實(shí)數(shù) On Error GoTo Err_Control 出錯(cuò)陷井 …… Err_Control: On Error 是出錯(cuò)陷井語句，在程序出錯(cuò)時(shí)將執(zhí)行On Error 后面的語句 GoTo Err_contorl 是程序跳轉(zhuǎn)語句，它的作用是在程序中尋找Err_control:，并執(zhí)行這一行后面的語句， 本例中Err_Control:后就是結(jié)束宏，所以只要出現(xiàn)錯(cuò)誤，程序中止。 Do 開始循環(huán) …… Loop ‘結(jié)束循環(huán) 這個(gè)循環(huán)就歷害了，它會(huì)無休止地進(jìn)行循環(huán)，好在本例中已經(jīng)有了一個(gè)出錯(cuò)陷井，當(dāng)用戶輸入回車時(shí)，由 于程序沒有得到點(diǎn)或坐標(biāo)，程序出錯(cuò)，跳出循環(huán)，中止程序。如果要人為控制跳出循環(huán)，可以在代碼中用 Exit Do 語句跳出循環(huán)。在For 變量和Next 變量之間如果要跳出循環(huán)，那么只要在循環(huán)體內(nèi)加一個(gè)Exit for 就可以跳出循環(huán)，關(guān)于這方面的例程以后會(huì)講到。 Call ThisDrawing.ModelSpace.AddLine(p1, p2) 畫直線 畫直線方法也是很常用的，它的兩個(gè)參數(shù)是點(diǎn)坐標(biāo)變量 本課到此結(jié)束，請(qǐng)做思考題： 連續(xù)畫圓，每次要求用戶輸入圓心、半徑，當(dāng)用戶不再輸入圓心或半徑時(shí)程序才退出 同心圓，其半徑為1-5 Autocad VBA 初級(jí)教程(第四課程序的調(diào)試和保存) 人非圣賢，孰能無過，初學(xué)者在編寫復(fù)雜程序時(shí)往往會(huì)出現(xiàn)一些意想不到的錯(cuò)誤，所以程序的調(diào)試顯得尤 為重要，隨著學(xué)習(xí)的深入，以后我們需要經(jīng)常進(jìn)行程序調(diào)試。事實(shí)上，對(duì)于那些資深程序員來說，調(diào)試程 序也是一項(xiàng)不可或缺的重要工作。 首先，在程序輸入階段，應(yīng)該充分利用VBA 編輯器的智能功能。當(dāng)你在寫代碼時(shí)，輸入一些字母后，編輯 器可以自動(dòng)列出合適的語句、對(duì)象、函數(shù)供你選擇，可以用上下鍵選擇，然后按TAB 鍵（它位于“Q”鍵左 邊）確認(rèn)。當(dāng)輸入一個(gè)回車符后程序會(huì)自動(dòng)對(duì)這條語句進(jìn)行分析，如果出現(xiàn)錯(cuò)誤就會(huì)提示。 我們經(jīng)常碰到的麻煩是程序的運(yùn)行結(jié)果和預(yù)計(jì)的不一樣，一般我會(huì)這樣做：首先要想一想可能是哪一個(gè)變 量有問題，然后去監(jiān)視這個(gè)變量(或表達(dá)式)，在程序合適的位置設(shè)置斷點(diǎn)，這樣可以使程序停下來看一看 這個(gè)變量有沒有按照我的設(shè)想在變化。下面我舉一個(gè)簡(jiǎn)單的例子，先看源代碼： sub test() for i=2 to 4 step 0.6 next i end sub 這是一個(gè)非常簡(jiǎn)單的循環(huán)，每一次循環(huán)i 便會(huì)增加0.6，當(dāng)循環(huán)3 次后i 值就變?yōu)?.4，但問題是每一次循 環(huán)時(shí)i 值變?yōu)槎嗌伲? 第一步：在菜單中選“調(diào)試”—“添加監(jiān)視”，在表達(dá)試中填“i”，點(diǎn)擊確定，這時(shí)你會(huì)看到臨視窗口中 會(huì)多一行。 第二步：把光標(biāo)移到代碼窗口中的“next i”行，按一下“F9”，于是每當(dāng)程序運(yùn)行到這里時(shí)就會(huì)暫停了。 好，一切就緒，請(qǐng)按F5 執(zhí)行程序，在監(jiān)視窗口中C 值立刻變?yōu)?，再按F5 繼續(xù)，C 值為2.6，再按幾次F5， 直到程序結(jié)束，這樣我們就成功監(jiān)視了C 值的變化。 第三步：在next i 行再按一次F9，清除斷點(diǎn)。監(jiān)視的表達(dá)式的右鍵菜單選擇“刪除監(jiān)視”。 另外，還可以用“逐語句”、“逐過程”、“運(yùn)行到光標(biāo)處”等方法進(jìn)行調(diào)試，這些都在調(diào)試菜單中，操 作比較簡(jiǎn)單，請(qǐng)讀者自行領(lǐng)悟。 到目前為止，我們所做的工程都是“嵌入式工程”，它只是嵌入在當(dāng)前的Autocad 圖形文件中， 以后打開 這個(gè)文件時(shí)代碼才會(huì)加載，如果別的dwg 文件也要使用，那就需要把代碼導(dǎo)出為.bas 文件，供其他dwg 文 件導(dǎo)入。在VBA 編輯器的“文件”菜單中有這兩個(gè)功能，一試便知。 ACAD VBA 還有一種工程叫“通用式工程”，只要進(jìn)入ACAD 就可以運(yùn)行，程序可以在不同用戶、不同的圖 形文件中共享，但是由于VBA 功能太強(qiáng)，有時(shí)候會(huì)出現(xiàn)一些意想不到的事情，所以在學(xué)習(xí)階段請(qǐng)暫時(shí)不要 這樣做。 本課結(jié)束，請(qǐng)做思考題；監(jiān)視下列代碼中的i 和j 的值，注意，此題雖然要監(jiān)視2 個(gè)變量，但是在代窗口 中只要設(shè)置1 個(gè)斷點(diǎn)就足夠了。 sub test() for i=2 to 4 step 0.6 for j=-5 to 2 step 5.5 next j next i end sub Autocad VBA 初級(jí)教程(第五課畫函數(shù)曲線) 先畫一組下圖拋物線。 下面是源碼： Sub myl() Dim p(0 To 49) As Double 定義點(diǎn)坐標(biāo) Dim myl As Object 定義引用曲線對(duì)象變量 co = 15 定義顏色 For a = 0.01 To 1 Step 0.02 開始循環(huán)畫拋物線 For i = -24 To 24 Step 2 開始畫多段線 j = i + 24 確定數(shù)組元素 p(j) = i 橫坐標(biāo) p(j + 1) = a * p(j) * p(j) / 10 縱坐標(biāo) Next i 至此p(0)-p(40)所有元素已定義，結(jié)束循環(huán) Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) 畫多段線 myl.Color = co 設(shè)置顏色屬性 co = co + 1 改變顏色，供下次定義曲線顏色 Next a End sub 為了鼓勵(lì)大家積極思考，從本課開始，我不再解釋每一條語句的作用，只對(duì)以前沒有提過的語句進(jìn)行一些 解釋，也許你一時(shí)很難明白，建議用上一課提到的跟蹤變量、添加斷點(diǎn)的辦法領(lǐng)悟每一條語句的作用，如 果有問題不懂請(qǐng)跟貼提問。 在跟蹤變量p 時(shí)請(qǐng)?jiān)诟櫞翱谥袉螕糇兞縫 前的+號(hào)，這樣可以看清數(shù)組p 中每一個(gè)元素的變化。 ACAD 沒有現(xiàn)成的畫拋物線命令，我們只能用程序編寫多段線畫近似拋物線。理論上，拋物線的X 值可以是 無限小、無限大，這里取值范圍在正負(fù)24 之間。 程序第二行：Dim myl As Object 定義引用曲線對(duì)象變量 Object 也是一種變量類型，它可以把變量定義為對(duì)象，本例中myl 變量將引用多段線，所以要定義為Objet 類型。 看畫多段線命令： Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) 畫多段線 其中括號(hào)中的p 是一個(gè)數(shù)組，這個(gè)數(shù)組的元素?cái)?shù)必須是偶數(shù)，每?jī)蓚€(gè)元數(shù)作為一個(gè)點(diǎn)坐標(biāo)。 等號(hào)前面部分“Set myl”的作用就將myl 變量去引用畫好的多段線。 myl.Color = co 設(shè)置顏色屬性。在ACAD 中，顏色可以用數(shù)字表示，本例中co 會(huì)增值，這樣就會(huì)有五彩 繽紛的效果。 本課第二張圖：正弦曲線，下面是源碼： Sub sinl() Dim p(0 To 719) As Double 定義點(diǎn)坐標(biāo) For i = 0 To 718 Step 2 開始畫多段線 p(i) = i * 2 * 3.1415926535897 / 360 橫坐標(biāo) p(i + 1) = 2 * Sin(p(i)) 縱坐標(biāo) Next i ThisDrawing.ModelSpace.AddLightWeightPolyline (p) 畫多段線 ZoomExtents 顯示整個(gè)圖形 End Sub p(i) = i * 2 * 3.1415926535897 / 360 橫坐標(biāo) 橫坐標(biāo)表示角度，后面表達(dá)式的作用是把角度轉(zhuǎn)化弧度 ZoomExtents 語句是縮放命令，它的作用是顯示整個(gè)圖形，消除圖形以外的區(qū)域 本課思考題：畫一條拋物線：y=0.5*x*x+3，其中X 取值范圍在正負(fù)50 之間 Autocad VBA 初級(jí)教程(第六課數(shù)據(jù)類型的轉(zhuǎn)換) 上一節(jié)課我們用一個(gè)簡(jiǎn)單的公式把角度轉(zhuǎn)化為弧度，這樣做便于大家理解。不過VBA 中有現(xiàn)成的方法可以 轉(zhuǎn)換數(shù)據(jù)類型。 我們舉例說明： jd = ThisDrawing.Utility.AngleToReal(30, 0) 這個(gè)表達(dá)式把角度30 度轉(zhuǎn)化為弧度，結(jié)果是.523598775598299。 AngleToReal 需要兩個(gè)參數(shù)，前面是表示要轉(zhuǎn)換角度的數(shù)字，而后面一個(gè)參數(shù)可以取值為0-4 之間的整數(shù)， 有如下意義： 0：十進(jìn)制角度；1：度分秒格式；2：梯度；3：弧度；4：測(cè)地單位 例：id= ThisDrawing.Utility.AngleToReal("62d30 10""", 1) 這個(gè)表達(dá)式計(jì)算62 度30 分10 秒的弧度 再看將字符串轉(zhuǎn)換為實(shí)數(shù)的方法：DistanceToReal 需要兩個(gè)參數(shù)，前一個(gè)參數(shù)是表示數(shù)值的字符串，后面可以取值1-5，表示數(shù)據(jù)格式，有如下意義： 1：科學(xué)計(jì)數(shù)；2：十進(jìn)制；3：工程計(jì)數(shù)——英尺加英寸；4：建筑計(jì)數(shù)——英尺加分?jǐn)?shù)英寸；5：分?jǐn)?shù)格式。 例：以下表達(dá)式得到一個(gè)12.5 的實(shí)數(shù) temp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1) temp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2) temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5) 而realtostring 方法正好相反，它把一個(gè)實(shí)數(shù)轉(zhuǎn)換為字符串。它需要3 個(gè)參數(shù) 第一個(gè)參數(shù)是一個(gè)實(shí)數(shù)，第二個(gè)參數(shù)表示數(shù)據(jù)格式，含義同上，最后一個(gè)參數(shù)表示精確到幾位小數(shù)。 temp1= ThisDrawing.Utility.RealToString(12.5, 1, 3) 得到這個(gè)字符串：“1.250E+01”， 下面介紹一些數(shù)型轉(zhuǎn)換函數(shù)： Cint，獲得一個(gè)整數(shù)，例：Cint(3.14159) ，得到3 Cvar，獲得一個(gè)Variant 類型的數(shù)值，例：Cvar("123" & "00")，得到”12300” Cdate，轉(zhuǎn)換為date 數(shù)據(jù)類型，例：MyShortTime = CDate("11:13:14 AM") 下面的代碼可以寫出一串?dāng)?shù)字，從000-099。 Sub test() Dim add0 As String Dim text As String Dim p(0 To 2) As Double p(1) = 0 Y 坐標(biāo)為0 p(2) = 0 Z 坐標(biāo)為0 For i = 0 To 99 開始循環(huán) If i < 10 Then 如果小于10 add0 = "00" 需要加00 Else 否則 add0 = "0" 需要加0 End If text = add0 & CStr(i) 加零，并轉(zhuǎn)換數(shù)據(jù) p(0) = i * 100 X 坐標(biāo) Call ThisDrawing.ModelSpace.AddText(text, p, 4) 寫字 Next i End Sub 重點(diǎn)解釋條件判斷語句： If 條件表達(dá)式Then …… Else …… End if 如果滿足條件那么程序往下執(zhí)行，到else 時(shí)不再往下執(zhí)行，直接跳到End if 后面 如果不滿足條件，程序跳到else 后往下運(yùn)行。 Call ThisDrawing.ModelSpace.AddText(text, p, 4) 寫字 這是寫單行文本，需要三個(gè)參數(shù)，分別是:寫的內(nèi)容、位置、字高 Autocad VBA 初級(jí)教程(第七課寫文字) 客觀地說，ACAD 寫字功能不夠歷害，而用VBA 可以使寫字效率更高。比較正規(guī)的做法是把定義文字樣式， 用樣式來控制文字的特性。我們還是用實(shí)例來學(xué)習(xí)，先看下面一段代碼，它的作用是先創(chuàng)建一個(gè)文字樣式， 然后用這個(gè)文字樣式寫一段多行文本。 Sub txt() Dim mytxt As AcadTextStyle 定義mytxt 變量為文本樣式 Dim p(0 To 2) As Double 定義坐標(biāo)變量 p(0) = 100: p(1) = 100: p(2) = 0 坐標(biāo)賦值 Set mytxt = ThisDrawing.TextStyles.Add("mytxt") 添加mytxt 樣式 mytxt.fontFile = "c:\windows\fonts\simfang.ttf" 設(shè)置字體文件為仿宋體 mytxt.Height = 100 字高 mytxt.Width = 0.8 寬高比 mytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) 傾斜角度（需轉(zhuǎn)為弧度） ThisDrawing.ActiveTextStyle = mytxt 將當(dāng)前文字樣式設(shè)置為mytxt Set txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，學(xué)到老}\P" & "此心自光明正大， 過人遠(yuǎn)矣") txtobj.LineSpacingFactor = 2 指定行間距 txtobj.AttachmentPoint = 3 右對(duì)齊（1 為左對(duì)齊，2 為居中） End Sub 我們看這條語句 Set mytxt = ThisDrawing.TextStyles.Add("mytxt") 添加文本樣式并賦值給mytxt 變量，只需要一個(gè)參數(shù)：文本樣式名 fontfile、height、width、ObliqueAngle 是文本樣式最常用的屬性 Call ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，學(xué)到老}\P" & "此心自光明正大，過人遠(yuǎn) 矣") 這條語句是寫文本，需要三個(gè)參數(shù)。第一個(gè)參數(shù)p 是坐標(biāo)，1400 是寬度，最后一個(gè)參數(shù)是文本內(nèi)容，其中 \p 是一個(gè)回車符 擴(kuò)大字符間距用\T 數(shù)字，例：\T3abc，使文字abc 的間距擴(kuò)大3 部，n 取值范圍是0.75-3 在論壇中有一個(gè)經(jīng)常被同好提及的問題：如何使用文字疊加。舉例說明：123\S+0.12^-0.34 \S 是格式字符，^是分隔符，前面的數(shù)字在上，后面的數(shù)字在下。 \C 是顏色格式字符，C 后面跟一個(gè)數(shù)字表示顏色 \A 是對(duì)齊方式，\A0，\A1,\A2 分別表示底部對(duì)齊、中間對(duì)齊和頂部對(duì)齊 Autocad VBA 初級(jí)教程(第八課:圖層操作) 先簡(jiǎn)單介紹兩條命令： 1、這條語句可以建立圖層： ThisDrawing.Layers.Add("新建圖層") 在括號(hào)中填寫圖層的名稱。 2、設(shè)置為當(dāng)前的圖層 ThisDrawing.ActiveLayer=圖層對(duì)象 注意，等號(hào)右邊的變量不能用圖層名稱，必須使用一個(gè)有效的圖層變量 以下一些屬性在圖層比較常用： LayerOn 打開關(guān)閉 Freeze 凍結(jié) Lock 鎖定 Color 顏色 Linetype 線型 看一個(gè)例題： 1、先在已有的圖層中尋找一個(gè)名為“新建圖層”的圖層 2、如果找到這個(gè)圖層，顯示該圖層的信息，并提示用戶是否需要設(shè)置為當(dāng)前圖層，如果用戶確認(rèn)，則設(shè)置 為當(dāng)前圖層。 3、如果圖層沒有找到，新建一個(gè)名為“新建圖層”的圖層，設(shè)置為黃色，HIDDEN 線型，并把這個(gè)圖層設(shè) 置為當(dāng)前圖層 Sub mylay() Dim lay0 As AcadLayer 定義作為圖層的變量 Dim lay1 As AcadLayer findlay = 0 尋找圖層的結(jié)果的變量，0 沒有找到，1 找到 For Each lay0 In ThisDrawing.Layers 在所有的圖層中進(jìn)行循環(huán) If lay0.Name = "新建圖層" Then 如果找到圖層名 findlay = 1 把變量改為1 標(biāo)志著圖層已經(jīng)找到 msgstr = lay0.Name + "已經(jīng)存在" + vbCrLf msgstr = msgstr + "圖層狀態(tài)：" + IIf(lay0.LayerOn = True, "打開", "關(guān)閉") + vbCrLf msgstr = msgstr + "圖層" + IIf(lay0.Freeze = True, "已經(jīng)", "沒有") + "凍結(jié)" + vbCrLf msgstr = msgstr + "圖層" + IIf(lay0.Lock = True, "已經(jīng)", "沒有") + "鎖定" + vbCrLf msgstr = msgstr + "圖層顏色號(hào)：" + CStr(lay0.Color) + vbCrLf msgstr = msgstr + "圖層線型：" + lay0.Linetype + vbCrLf msgstr = msgstr + "圖層線寬：" + CStr(lay0.Lineweight) + vbCrLf msgstr = msgstr + "打印開關(guān)" + IIf(lay0.Plottable = False, "關(guān)閉", "打開") + vbCrLf + vbCrLf msgstr = msgstr + "是否設(shè)置為當(dāng)前圖層？" If MsgBox(msgstr, 1) = 1 Then 如果用戶點(diǎn)擊確定 If Not lay0.LayerOn Then lay0.LayerOn = True 打開 ThisDrawing.ActiveLayer = lay0 把當(dāng)前圖層設(shè)為已經(jīng)存在的圖層 End If Exit For 結(jié)束尋找 End If Next lay0 If findlay = 0 Then 沒有找到圖層 Set lay1 = ThisDrawing.Layers.Add("新建圖層") 增加一個(gè)名為“臨時(shí)圖層”的圖層 lay1.Color = 2 圖層設(shè)置為黃色 ltfind = 0 找到線型的標(biāo)志，0 沒有找到，1 找到 For Each entry In ThisDrawing.Linetypes 在現(xiàn)有的線型中進(jìn)行循環(huán) If StrComp(entry.Name, "HIDDEN") = 0 Then 如果線型名為"HIDDEN" ltfind = 1 標(biāo)志為已找到線型 Exit For 退出循環(huán) End If Next entry 結(jié)束循環(huán) If ltfind = 0 Then 沒有找到線型 ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" 加載線型 End If lay1.Linetype = "HIDDEN" 設(shè)置線型 ThisDrawing.ActiveLayer = lay1 將當(dāng)前圖層設(shè)置為新建圖層 End If End Sub 在尋找圖時(shí)時(shí)我們用到for each……next 語句 它的語法是這樣的： For Each 變量In 數(shù)組或集合對(duì)象 …… exit for …… next 變量 它的作用是在數(shù)組或集合對(duì)象中進(jìn)行循環(huán)，每循環(huán)一次，變量就成為數(shù)組或集合對(duì)象中的一個(gè)元素。本例 在所有的圖層對(duì)象中進(jìn)行循環(huán)，每循環(huán)一次layo 變量就代表一個(gè)圖層 在循環(huán)體中遇到exit for 語句則退出循環(huán)，如果沒有exit for，循環(huán)將在所有的元素都操作一遍后結(jié)束。 If lay0.Name = "新建圖層" Then lay0.name 代表這處圖層的圖層名 IIf(lay0.LayerOn = True, "打開", "關(guān)閉") 這是一個(gè)簡(jiǎn)單判斷語句，語法如下： iif（判斷表達(dá)式，返回值1，返回值2） 當(dāng)判斷表達(dá)式成立，函數(shù)值=返回值1，如果表達(dá)式不成立，函數(shù)值=2 MsgBox(msgstr, 1) Mgbox 顯示一個(gè)對(duì)話框，第一個(gè)參數(shù)是對(duì)話框顯示的內(nèi)容 第二個(gè)參數(shù)可以控制對(duì)話框上的按鈕。 0 只有確認(rèn)按鈕 1 確認(rèn)、取消 2 終止、重試、忽略 3 是、否、取消 4 是、否 MsgBox 獲得值如下： 確認(rèn)：1 取消：2 終止：3 重試：4 忽略：5 是：6 否7 初學(xué)者不需要死記硬背，能有所了解就行了 ACAD 圖層中最麻煩的就是線型問題了，本例先尋找一個(gè)HIDDEN 線型，如果找不到就加載這個(gè)線型，用這 條語句： ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" ThisDrawing.Linetypes.Load 后需要兩個(gè)參數(shù)，一個(gè)是線型的名稱，另外一個(gè)是線型文件的名稱。 利用vba 編程實(shí)現(xiàn)從excel 表到autocad 表轉(zhuǎn)換.txt --- 一、前言 ---- Microsoft Excel 軟件具有十分強(qiáng)大的制表、表格計(jì)算等功能，是普通人員常用的制表工具。 可以通過其內(nèi)嵌的VBA 語言可以控制Microsoft Excel 的整個(gè)操作過程。 ---- AutoCAD 是由AutoDesk 公司的工程繪圖軟件，是CAD 市場(chǎng)的主流產(chǎn)品， 功能十分強(qiáng)大，是工程制圖人員常用的軟件之一。AutoDesk 公司從R14 版以后， 為其提供了VBA 語言接口。 ---- 在工程制圖中，常常需要在圖中插入繪制表格，一般有兩種方法。 其一，是利用剪貼板，將Microsoft Excel 表格拷貝至剪貼板中，然后打開AutoCAD 文件，再將剪貼板中的文 件粘貼至所需位置。這種方法十分簡(jiǎn)單，但有其固有的缺點(diǎn)。①在保存文件必須 將.xls 和.dwg 文件保存在一起，一旦缺少excel 環(huán)境，則再對(duì)表格繼續(xù)修改。 ②同時(shí)打開多個(gè)表格操作，需要占據(jù)較大的內(nèi)存空間。③文件體積變得很大，表 格有時(shí)在.dwg 文件中以圖標(biāo)形式顯示，不便于觀察。 ---- 第二種方法，即利用Microsoft Excel、AutoCAD 都提供的VBA 功能， 編制程序進(jìn)行轉(zhuǎn)換，將Microsoft Excel 表格按原來樣子轉(zhuǎn)換，即把Microsoft Excel 表格中的文字和線條信息全部讀取出來，在AutoCAD 文件里按照一 一對(duì)應(yīng)的方式寫出來，確保轉(zhuǎn)換后的表格與原表格一致。這樣徹底避免了前種方 法的缺點(diǎn)，便于表格內(nèi)容編輯。本文著重介紹此方法。 ---- 二、表格轉(zhuǎn)換工作機(jī)理分析及具體實(shí)現(xiàn)方法 ---- 1．表格轉(zhuǎn)換工作機(jī)理分析 ---- 在制表過程中，經(jīng)常遇到兩個(gè)概念，表和方格。 ---- 在Microsoft Excel 中，與表對(duì)應(yīng)的對(duì)象是工作表（Sheet 或Worksheet）,與每一個(gè)表 格方格相對(duì)應(yīng)的對(duì)象是單元格區(qū)域（range），它可以僅包括一個(gè)單元格（cell）, 也可以由多個(gè)單元格合并而成。 ---- 在AutoCAD 中，沒有與表對(duì)應(yīng)的對(duì)象，但表可以理解由若干條線和 文字對(duì)象組合而成。 ---- 根據(jù)上述分析，可以發(fā)現(xiàn)如下的轉(zhuǎn)換方法： ---- 讀取Microsoft Excel 文件中的最小對(duì)象----單元格區(qū)域(range)的主要信息---線條和 文字，然后在AutoCAD 文件里在指定圖層、位置畫線條，書寫文字。通過循環(huán)， 遍歷所有單元格區(qū)域(range),邊讀邊寫，最終完成表格的轉(zhuǎn)換。轉(zhuǎn)換過程中，保 持線條、文字及其相關(guān)屬性不發(fā)生改變。 ---- 下面就轉(zhuǎn)換工作的兩個(gè)主要對(duì)象表格線條和表格文字進(jìn)行討論。 ---- 2、表格線條的轉(zhuǎn)換 ---- Microsoft Excel 中內(nèi)嵌的VBA 為我們獲取Excel 文件信息提供了極大便利。通常，通過訪 問range 對(duì)象，可以獲得許多信息。訪問分析表格的屬性應(yīng)從分析range 開始。 每一個(gè)range 包括許多對(duì)象和屬性,例如,font 對(duì)象可以返回range 的字體信息。 通過遍歷,即可獲得整個(gè)表格信息。獲取表格信息的目的在于準(zhǔn)確地按照位置畫 表格線，同時(shí)確定文字位置。 ---- 在獲取表格信息時(shí)，存在一個(gè)最佳算法問題。以下就畫線問題為例， 闡明問題和解決方法。 ---- 假設(shè)表格由a(a>=1)行b(b>=1)列組成,x，y 為循環(huán)變量, 表格完全由單元格組成，由于在每個(gè)單元格都有4 條邊，讓x 從1 開始循 環(huán)到a, 再y 從1 開始循環(huán)到b,讀取每個(gè)單元格的4 條邊,會(huì)讀取a*b*4 次，重復(fù) 讀取a*b*2 次。當(dāng)x=1 時(shí)，讀取上邊；當(dāng)y=1 時(shí)讀取,左邊，其余情況讀取右邊， 下邊。共讀取a+b+ a*b*2 次。以3 行4 列為例，共讀取3+4+3*4*2=31 次，與實(shí)際表格的邊 數(shù)相同，沒有重復(fù)讀取。 ---- 對(duì)合并單元格信息的讀取是個(gè)難點(diǎn)。因?yàn)槿绻凑諉卧竦奈恢靡来巫x 取，那么由a 行b 列個(gè)單元格（cell）合并而成的單元格區(qū)域(range)僅有4 條 邊，采用上述計(jì)算方法，需要讀取a+b+ a*b*2 次，重復(fù)讀取a+b+ a*b*2 - 4 次。以以3 行4 列為例，共讀取 3+4+3*4*2=31 次，重復(fù)讀取31 - 4=27 次。算法有重復(fù)。如果按照行號(hào)，列號(hào)讀取，合并單元格的行號(hào)、 列號(hào)只有一個(gè)，其值為最靠左、靠上的那個(gè)單元格的行號(hào)、列號(hào)。例如，將A2： E5 的單元格合并后，其行號(hào)為2，列號(hào)為A。這樣由多個(gè)合并單元格組合后的表 格行號(hào)、列號(hào)有間斷，不連續(xù)，無法進(jìn)行循環(huán)讀取信息。筆者通過研究發(fā)現(xiàn)，函 數(shù)address（）和單元格的mergearea 屬性可以獲得合并單元格的準(zhǔn)確信息。具 體方法為：讀取cells(x,y)單元格時(shí)，用address()判斷包含cells(x,y)單元 格的合并單元格區(qū)域c.mergearea 的絕對(duì)地址,如果前4 個(gè)字符與cells(x,y) 單元格的地址相同，為cells(x,y)單元格為合并單元格區(qū)域最靠上、靠 左的那個(gè)合并單元格，讀取其4 條邊信息，否則不讀取。這樣，徹底避免了重復(fù) 讀取，同時(shí)提高了整個(gè)讀取和畫線速度。 ---- 在AutoCAD 中，線條有多種，考慮能夠方便控制線條屬性，選用了 多義線。具體命令如下： RetVal = object.AddLightWeightPolyline(VerticesList) ---- 下面的程序演示表格線條讀取和畫表格線的具體過程。 Sub hxw() Dim a as interger ‘表格的最大行數(shù) Dim b as interger ‘表格的最大列數(shù) Dim xinit as double ‘插入點(diǎn)x 坐標(biāo) Dim yinit as double ‘插入點(diǎn)y 坐標(biāo) Dim zinit as double ‘插入點(diǎn)z 坐標(biāo) Dim xinsert as double ‘當(dāng)前單元格的左上角點(diǎn)的x 左標(biāo) Dim yinsert as double ’當(dāng)前單元格的左上角點(diǎn)的y 左標(biāo) Dim ptarray (0 to 2) as double Dim x as integer Dim y as integer For x =1 to a For y=1 to b Set c = xlsheet.Range(zh(y) + Trim(Str(x))) ‘以行號(hào)、列號(hào)獲得單元格地址 Set ma = c.MergeArea ‘求出單元格C 的合并單元格地址 If Left(Trim(ma.Address), 4) = Trim(c.Address) Then 假如c.mergearea 的絕對(duì)地址,如果前4 個(gè)字符與c 單元格的地址相同 xl = "A1:" + ma.Address xh = xlsheet.Range(ma.Address).Width yh = xlsheet.Range(ma.Address).Height Set xlrange = xlsheet.Range(xl) xinsert = xlrange.Width - xh yinsert = xlrange.Height - yh xpoint = xinit + xinsert ypoint = yinit - yinsert If x = 1 Then If ma.Borders(xlEdgeTop).LineStyle <> xlNone Then ptArray(0) = xpoint ‘第一點(diǎn)坐標(biāo)（數(shù)組下標(biāo)0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh ‘第二點(diǎn)坐標(biāo)（數(shù)組下標(biāo)2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight End If If ma.Borders(xlEdgeBottom).LineStyle < > xlNone Then ptArray(0) = xpoint + xh ‘第三點(diǎn)坐標(biāo)（數(shù)組下標(biāo)0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint ‘第四點(diǎn)坐標(biāo)（數(shù)組下標(biāo)2 and 3） ptArray(3) = ypoint – yh Lineweight lwployobj, ma.Borders(xlEdgeBottom).Weight End If If y = 1 Then If ma.Borders(xlEdgeLeft).LineStyle < > xlNone Then ptArray(0) = xpoint ‘第四點(diǎn)坐標(biāo)（數(shù)組下標(biāo)0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint ‘第一點(diǎn)坐標(biāo)（數(shù)組下標(biāo)2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight End If If ma.Borders(xlEdgeRight).LineStyle < > xlNone Then ptArray(0) = xpoint + xh ‘第二點(diǎn)坐標(biāo)（數(shù)組下標(biāo)0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh ‘第三點(diǎn)坐標(biāo)（數(shù)組下標(biāo)2 and 3） ptArray(3) = ypoint – yh Lineweight lwployobj, ma.Borders(xlEdgeRight).Weight End If Set lwployobj = moSpace.AddLightWeightPolyline(ptArray) ‘在AutoCAD 文件里畫線 With lwployobj .Layer = newlayer.name ‘指定lwployobj 所在圖層 .Color = acBlue ‘指定lwployobj 的顏色 End With Lwployobj.Update Next y Next x End Sub ‘下面程序控制線條粗細(xì) Sub Lineweight(ByVal line As Object, u As Integer) Select Case u Case 1 Call line.SetWidth(0, 0.1, 0.1) Case 2 Call line.SetWidth(0, 0.3, 0.3) Case -4138 Call line.SetWidth(0, 0.5, 0.5) Case 4 Call line.SetWidth(0, 1, 1) Case Else Call line.SetWidth(0, 0.1, 0.1) End Select End Sub ‘下面程序完成列號(hào)轉(zhuǎn)換 Function zh(pp As Integer) As String If pp < 26 Then zh = Chr(64 + pp) Else zh = Chr(64 + Int(pp / 26)) + Chr(64 + pp Mod 26) End If End Function__