《CADVBA初級教程(全).doc》由會員分享，可在線閱讀，更多相關《CADVBA初級教程(全).doc（15頁珍藏版）》請在裝配圖網上搜索。

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