VBA開發(fā)CAD經(jīng)驗(yàn).pdf

大家知道什么是宏嗎 說白它就是 VBA 過程 看下面的代碼 Public Sub MacroDemo MsgBox Hello Welcome to AutoCAD VBA End Sub 這就是宏 打開 CAD 輸入命令 vbaide 回車會出現(xiàn) VBA 的編輯界面 雙擊 ThisDrawing 在右側(cè)的代碼 區(qū)輸入上面的代碼 如下圖 然后按 F5 鍵會出現(xiàn)宏窗口 如下圖 點(diǎn)擊運(yùn)行 大家看到什么 這就是一個最簡單的一個用 VBA 對 CAD 進(jìn)行二次開發(fā)的程序 也就是宏 那什么是VBA呢 VBA就是 VB的一個子集它的全稱是Visual Basic For Application 它具有 VB 的大部分功能 既然我們選擇了 VBA 我們首先要知道 VBA 能操作 CAD 里的哪些對象呢 打開 VBAIDE 窗口按下 F2 鍵會出現(xiàn)對象瀏覽器 如下圖 庫選擇 AutoCAD 這時下面顯示的就是 CAD 為 VBA 提供的可操作的對象的類了 這時有的人因沒有基礎(chǔ) 所以還是一頭霧水 別怕 選中一個類圖標(biāo)后按 F1 這時會彈出 AutoCAD ActiveX and VBA Reference 選擇最上面的一個子項(xiàng) Object Model 對象模型 這個 就是在 CAD 里那些對象的關(guān)系 如下圖 如果英文不好的話 可以安裝 CAD2000 它的這個部分是中文的 為想學(xué)好 VBA 二次開發(fā) 這個是必需的 而且 VBA 對 Office 的二次開發(fā)也是這樣的 這個在編程界叫做 Active X 包括 Active X 控件 Active X DLL 和 Active X EXE 就好比一個程序?yàn)槠渌绦蛱峁┑囊粋€后門一樣 下面我就給大家講一下菜單吧 因?yàn)槲覀冇玫降钠渌咀?CAD 二次開發(fā)的插件 從直觀上首先接觸的就是它的菜單 剛 開始用的時候就是從它的菜單開始接觸的 我經(jīng)常用到的做菜單的方法有兩種 一種是用 CAD 的菜單文件 另一種就是用 VBA 代碼 直接長成菜單 我先介紹第一種 CAD 的菜單文件 它是文本文件 我們用記事本就可打開并編輯它 或者再重新創(chuàng)建一個 說到這里有的人可能要問了 我應(yīng)該從何處開始入手呢 要怎樣做呢 別急 CAD 本身就有現(xiàn)成的供我們參考 就放在 CAD 的安裝文件夾下的 Support 文件夾內(nèi) 或者其它插件的文件夾內(nèi) 找不到可以按 F3 搜一下 擴(kuò)展名分別為 mnu mns mnc 默認(rèn)的菜單文件是 acad mnu 原始 ASCII 菜單文件 即用戶通常編輯或創(chuàng)建的文件 該文 件以查看完整菜單文件的外表特征 mnc 已編譯的菜單文件 一種二進(jìn)制文件 包含用于定義菜單或其他界面元素的功能及外 觀的命令字符串和菜單語法 首次加載 MNU 文件時 AutoCAD 將編譯此文件 mns 源菜單文件 一種與 MNU 文件相同的 ASCII 文件 但是不包含注釋或特殊格式 每次菜單文件的內(nèi)容被更改時 AutoCAD 將修改源菜單文件 mnr 菜單資源文件 一種二進(jìn)制文件 包含由菜單或其他界面元素使用的位圖 AutoCAD 每 次編譯 MNC 文件時 均生成菜單資源文件 mnt 菜單資源文件 僅在 MNR 文件無效 例如 只讀 時生成該文件 mnl 菜單 LISP 文件 包含菜單文件使用的 AutoLISP 表達(dá)式 當(dāng)加載與菜單 LISP 文件 具有相同文件名的菜單文件時 AutoCAD 會將菜單 LISP 文件加載至內(nèi)存 自己做的 mns 的文件內(nèi)容如下 AutoCAD 菜單文件 C Documents and Settings wuyp Local Settings Application Data Autodesk AutoCAD 2004 R16 0 chs FD04Menu mns MENUGROUP wyp POP1 WYP ID COMPUTE 富地 2004 C ID TongXin 通信 CTRL SHIFT A C C vbarun F 編程 作品 CAD 二次開發(fā) 二次 開發(fā) Vba 計(jì)算 通信 dvb Module1 TongXin ID WorkAffiliation 工作聯(lián)系單 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 AcadVBA dvb ModWorkAffiliation WorkAffiliation ID StyleBook 樣本查詢 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì) 算 AcadVBA dvb ModStyleBook StyleBook ID DRAW 繪圖工具 ID ZISZERO 多義線各節(jié)點(diǎn) Z 軸設(shè)為零 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 Z 軸為 0 dvb Module1 SetZIs0 ID LuoXuanXian 三維螺旋線 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 螺旋線 dvb Module1 LuoXuanXian ID JKX 設(shè)計(jì)工具 ID MXB 導(dǎo)出明細(xì)表 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 AcadVBA dvb ModMXB mxb ID YGXCKDGS 圓管型材寬度估算 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 圓管型材寬度估算 dvb Module1 YGXCKDGS ID BKJQJS 圓管型材寬度精算 CTRL SHIFT S C C vbarun F 編程 作品 CAD 二 次開發(fā) 二次開發(fā) Vba 計(jì)算 圓管型材寬度精算 dvb Module1 BKJQJS ID NDJS 撓度計(jì)算 CTRL SHIFT C C C vbarun F 編程 作品 CAD 二次開 發(fā) 二次開發(fā) Vba 計(jì)算 撓度計(jì)算 dvb Module1 NDJS ID BULK1 體積 CTRL SHIFT Z C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 體積 dvb Module1 bulk ID LianLun 鏈輪參數(shù) C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì) 算 鏈輪參數(shù) dvb Module1 LianLun ID YLGBHJS 壓力管壁厚計(jì)算 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次 開發(fā) Vba 計(jì)算 壓力管壁厚計(jì)算 dvb Module1 YLGBHJS ID GTBHJS 缸筒壁厚計(jì)算 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開 發(fā) Vba 計(jì)算 缸筒壁厚計(jì)算 dvb Module1 GTBHJS ID Bearing 軸承型號大全 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 AcadVBA dvb ModBearing Bearing ID LiuLiang 油缸流量計(jì)算 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 流量計(jì)算 dvb Module1 LiuLiang ID YYZHDJGL 液壓站電機(jī)功率計(jì)算 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次 開發(fā) Vba 計(jì)算 AcadVBA dvb modYYZHDJGL YYZHDJGL id GearMatching CAD 系統(tǒng)設(shè)置 ID MButton 鼠標(biāo)中鍵控制 ID MButtonPan 鼠標(biāo)中鍵平移 C C setvar mbuttonpan 1 ID MButtonMenu 設(shè)置正角度的方向 ID anticlockwise 逆時針 C C setvar ANGDIR 0 ID deasil 隱含邊延伸模式 ID extend 延伸 E C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 AcadVBA dvb ModExtendMode extend ID NoExtend 顯示文件對話框 ID filediaON 顯示 C C setvar filedia 1 ID filediaOFF 設(shè)置修剪和延伸的當(dāng)前 投影 模式 ID PROJMODE0 真三維模式 無投影 C C setvar PROJMODE 0 ID PROJMODE1 投影到當(dāng)前 UCS 的 XY 平面上 C C setvar PROJMODE 1 ID PROJMODE2 預(yù)覽圖像是否隨圖形一起保存 ID RASTERPREVIEWOFF 不創(chuàng)建預(yù)覽圖像 C C setvar RASTERPREVIEW 0 ID RASTERPREVIEWON 寄出錯誤報告到 ID REPORTERRORON 顯示 C C setvar REPORTERROR 1 ID REPORTERROROFF 雙擊鼠標(biāo)編輯對象 ID PICKSTYLE OK 使用 C C setvar PICKSTYLE 0 ID PICKSTYLE NO 不使用 C C setvar PICKSTYLE 1 ID ANGBASE 基準(zhǔn)角置零 圖案為Ansi31 C C vbarun F 編程 作品 CAD二次開發(fā) 二次開發(fā) Vba 計(jì)算 AcadVBA dvb modCADSysVariant AngBaseIs0 ID ZOOMFACTOR 鼠標(biāo)輥掄縮放速度 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 鼠標(biāo)輥掄縮放速度 dvb Module1 SFSD ID HPNAME 設(shè)置默認(rèn)填充圖案為 ANSI31 C C setvar HPNAME ansi31 ID CELTSCALE 設(shè)置當(dāng)前對象的線型比例因子為 1 C C setvar CELTSCALE 1 ID QLHCHBC Windows 系統(tǒng)工具 ID CALC 計(jì)算器 CTRL SHIFT ALT Z C C vbarun F 編程 作品 CAD 二 次開發(fā) 二次開發(fā) Vba 計(jì)算 winsystools dvb Module1 calc ID Mspaint 畫筆 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 winsystools dvb Module1 mspaint ID CALC1 實(shí)用計(jì)算器 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 winsystools dvb Module1 calc1 ID ChangeWPaper 電話表 ID FDTel 公司電話表 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 AcadVBA dvb modTel FDTel ID ZHGTel 菜單 ID Update CAD2002 菜單更新 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開 發(fā) Vba 計(jì)算 UpdateFDMenu dvb Module1 Update02menu ID Update04 這句是在 CAD 中的菜單組名 POP1 這行為彈出菜單標(biāo)識 pop 加上數(shù)字 至于此部分的說明如下 MENUGROUP 菜單組名 BUTTONSn 定點(diǎn)設(shè)備按鈕菜單 AUXn 系統(tǒng)定點(diǎn)設(shè)備菜單 POPn 下拉菜單和快捷菜單 TOOLBARS 工具欄定義 IMAGE 圖像控件菜單 SCREEN 屏幕菜單 TABLETn 數(shù)字化儀菜單 HELPSTRINGS 當(dāng)亮顯下拉菜單或快捷菜單項(xiàng)時 或者當(dāng)光標(biāo)位于工具欄按鈕上時 顯 示狀態(tài)欄中的文字 ACCELERATORS 快捷鍵 或加速鍵 定義 下面這句就開始定義菜單上的項(xiàng)目了 ID COMPUTE 富地 2004 C 其中前面的 ID COMPUTE 就是這個菜單項(xiàng)的唯一的標(biāo)識 方括號內(nèi)的就是菜單上顯示的內(nèi) 容了 括號內(nèi)的那個連字符加上一個字母 C 它在菜單上會顯示 C 下面帶一個下劃線 這 個就是我們定義的熱鍵 當(dāng)屏幕顯示此菜單時我們按 Alt C 鍵時 就相當(dāng)于我們用鼠標(biāo)點(diǎn)擊 此菜單 在這行的后面我們什么也沒加 是因?yàn)檫@是菜單的第一個項(xiàng) 因此不需要它做什么 下一行的后面的這個 C C vbarun F 編程 作品 CAD 二次開發(fā) 二次開發(fā) Vba 計(jì)算 通 信 dvb Module1 TongXin 是我們點(diǎn)擊此菜單項(xiàng)所執(zhí)行的動作 前面的 C C 是相當(dāng)于按了兩 次 Esc 鍵 主要是為了取消前一個正在運(yùn)行的命令 下面的 vbarun 是運(yùn)行 VBA 程序的命令 再后面的的就是這個 VBA 宏文件的路徑和名稱了 如果將此宏文件的路徑加到 CAD 支持 文件的搜索路徑內(nèi) 就可以去掉前面的路徑了 要注意的是在后面的行中的方括號內(nèi)有 和鼠標(biāo)中鍵控制 ID MButtonPan 鼠標(biāo)中鍵平移 C C setvar mbuttonpan 1 ID MButtonMenu 顯示文件對話框 ID filediaON 顯示 C C setvar filedia 1 ID filediaOFF 不顯示 C C setvar filedia 0 ID ZOOMFACTOR 鼠標(biāo)輥掄縮放速度 C C vbarun c Tests dvb Module1 SFSD ID CALC 計(jì)算器 C C vbarun C Tests dvb Module1 calc ID CIRCLE 畫圓 C C vbarun C Tests dvb Module1 circles ID MENUUPDATE 菜單更新 C C vbarun C Tests dvb Module1 updatemenus TOOLBARS HELPSTRINGS ID CALC 打開計(jì)算器 ID MButtonPan 當(dāng)按下鼠標(biāo)中鍵平移視口 ID MButtonMenu 當(dāng)按下鼠標(biāo)中鍵彈出菜單 ID filediaON 當(dāng)對文件進(jìn)行操作時打顯示件對話框 ID filediaOFF 當(dāng)對文件進(jìn)行操作時顯示文件對話框 ID ZOOMFACTOR 設(shè)置鼠標(biāo)輥輪的縮放速度 ID CIRCLE 畫一個圓 ID MENUUPDATE 從菜單文件更新此菜單 VBA 源程序文件名為 Tests dvb 放在 C 盤根目錄 里面添加一個模塊 名為 Module1 兩個窗 體分別名為 frmCircle 和 frmMouse Module1 里面的代碼為下面內(nèi)容 Option Explicit Dim MnuGroup AsAcadMenuGroup Public Enum enuLineType ltContinuous 0 ltCenter 1 ltDASHED 2 ltPHANTOM 3 End Enum Public Sub calc Shell calc exe vbNormalFocus End Sub Public Sub SFSD frmMouse Show End Sub Public Sub Circles frmCircle Show End Sub Public Sub UpdateMenu End Sub 判斷圖層是否存在 Public Function LayerExist ByVal strLayerName As String As Boolean Dim objLayer As AcadLayer For Each objLayer In ThisDrawing Layers If objLayer Name strLayerName Then LayerExist True Exit For End If Next End Function 添加圖層 Public Function AddLayers ByVal strLayerName As String LineType As enuLineType lColor As ACAD COLOR lineWeightAs AcLineWeight AsAcadLayer Dim objLayer As AcadLayer On Error GoTo LineError Set objLayer ThisDrawing Layers Add strLayerName If LineTypeExist LineType False Then ThisDrawing Linetypes Load GetLineTypeString LineType acadiso lin 添加線型 End If objLayer LineType GetLineTypeString LineType objLayer color lColor objLayer lineWeight lineWeight Set AddLayers objLayer Exit Function LineError MsgBox Err Number Chr 13 Err Description 16 End Function 獲得圖層 Public Function GetLayer ByVal strLayerName As String As AcadLayer Dim objLayer As AcadLayer For Each objLayer In ThisDrawing Layers If objLayer Name strLayerName Then Set GetLayer objLayer Exit For End If Next End Function 判斷線型是否存在 Private Function LineTypeExist ByVal LineTypeName As enuLineType As Boolean Dim objLineType As AcadLineType For Each objLineType In ThisDrawing Linetypes If objLineType Name GetLineTypeString LineTypeName Then LineTypeExist True Exit For End If Next End Function Private Function GetLineTypeString ByVal LineTypeAs enuLineType As String Select Case LineType Case Is ltContinuous GetLineTypeString Continuous Case Is ltCenter GetLineTypeString CENTER Case Is ltDASHED GetLineTypeString DASHED Case Is ltPHANTOM GetLineTypeString PHANTOM End Select End Function Public Sub UpdateMenus On Error Resume Next Application MenuGroups Item Test Unload Application MenuGroups Load c Test mns Set MnuGroup Application MenuGroups Item Test MnuGroup Menus InsertMenuInMenuBar Test T Application MenuBar Count 1 End Sub frmCircle 的窗體內(nèi)容為 窗體內(nèi)的代碼為 Option Explicit Dim dblPoints 2 As Double dblR As Double Private Sub cmdOK Click Dim objCircle As AcadCircle Dim objLayer As AcadLayer objOldLayer As AcadLayer Dim dblStart 2 As Double dblEnd 2 As Double dblExtend As Double dblPoints 0 Val txtX Text dblPoints 1 Val txtY Text dblPoints 2 Val txtZ Text dblR Val txtR Text dblExtend Val TxtExtend Text If LayerExist 輪廓線層 False Then Set objLayer AddLayers 輪廓線層 ltContinuous acWhite acLnWtByLwDefault 添加輪廓線層 Else Set objLayer GetLayer 輪廓線層 End If Set objOldLayer ThisDrawing ActiveLayer 保存原來的圖層 ThisDrawing ActiveLayer objLayer 設(shè)置輪廓線層為當(dāng)前層 Set objCircle ThisDrawing ModelSpace AddCircle dblPoints Val txtR Text 畫圓 If LayerExist 中心線層 False Then Set objLayer AddLayers 中心線層 ltCenter acRed acLnWtByLwDefault 添加中心線層 Else Set objLayer GetLayer 中心線層 End If ThisDrawing ActiveLayer objLayer 設(shè)置中心線層為當(dāng)前層 dblStart 0 dblPoints 0 dblR dblExtend dblStart 1 dblPoints 1 dblStart 2 dblPoints 2 dblEnd 0 dblPoints 0 dblR dblExtend dblEnd 1 dblPoints 1 dblEnd 2 dblPoints 2 ThisDrawing ModelSpace AddLine dblStart dblEnd dblStart 0 dblPoints 0 dblStart 1 dblPoints 1 dblR dblExtend