cad二次開發(fā)基礎(chǔ)教程和實(shí)例檔.doc

大家知道什么是宏嗎？說白它就是VBA過程?？聪旅娴拇a：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)槲覀冇玫降钠渌咀鯟AD二次開發(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 SettingswuypLocal SettingsApplication DataAutodeskAutoCAD 2004R16.0chsFD04Menu.mns/*MENUGROUP=wyp*POP1*WYPID_COMPUTE 富地2004(&C)ID_TongXin 通信. CTRL+SHIFT+ACC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/通信.dvb!Module1.TongXinID_WorkAffiliation 工作聯(lián)系單.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!ModWorkAffiliation.WorkAffiliation ID_StyleBook 樣本查詢.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!ModStyleBook.StyleBookID_DRAW -繪圖工具ID_ZISZERO 多義線各節(jié)點(diǎn)Z軸設(shè)為零CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/Z軸為0.dvb!Module1.SetZIs0ID_LuoXuanXian 三維螺旋線.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/螺旋線.dvb!Module1.LuoXuanXianID_JKX 設(shè)計工具ID_MXB 導(dǎo)出明細(xì)表.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!ModMXB.mxbID_YGXCKDGS 圓管型材寬度估算.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/圓管型材寬度估算.dvb!Module1.YGXCKDGSID_BKJQJS 圓管型材寬度精算. CTRL+SHIFT+SCC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/圓管型材寬度精算.dvb!Module1.BKJQJSID_NDJS 撓度計算. CTRL+SHIFT+CCC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/撓度計算.dvb!Module1.NDJSID_BULK1 體積. CTRL+SHIFT+ZCC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/體積.dvb!Module1.bulkID_LianLun 鏈輪參數(shù)CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/鏈輪參數(shù).dvb!Module1.LianLunID_YLGBHJS 壓力管壁厚計算.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/壓力管壁厚計算.dvb!Module1.YLGBHJSID_GTBHJS 缸筒壁厚計算.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/缸筒壁厚計算.dvb!Module1.GTBHJSID_Bearing 軸承型號大全.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!ModBearing.BearingID_LiuLiang 油缸流量計算CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/流量計算.dvb!Module1.LiuLiangID_YYZHDJGL 液壓站電機(jī)功率計算CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!modYYZHDJGL.YYZHDJGLid_GearMatching CAD系統(tǒng)設(shè)置ID_MButton -鼠標(biāo)中鍵控制ID_MButtonPan 鼠標(biāo)中鍵平移CC_setvar mbuttonpan 1ID_MButtonMenu 設(shè)置正角度的方向ID_anticlockwise 逆時針CC_setvar ANGDIR 0ID_deasil 隱含邊延伸模式ID_extend 延伸(&E)CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!ModExtendMode.extendID_NoExtend 顯示文件對話框ID_filediaON 顯示CC_setvar filedia 1ID_filediaOFF 設(shè)置修剪和延伸的當(dāng)前“投影”模式ID_PROJMODE0 真三維模式(無投影)CC_setvar PROJMODE 0ID_PROJMODE1 投影到當(dāng)前UCS的XY平面上CC_setvar PROJMODE 1ID_PROJMODE2 預(yù)覽圖像是否隨圖形一起保存ID_RASTERPREVIEWOFF 不創(chuàng)建預(yù)覽圖像CC_setvar RASTERPREVIEW 0ID_RASTERPREVIEWON 寄出錯誤報告到ID_REPORTERRORON 顯示CC_setvar REPORTERROR 1ID_REPORTERROROFF 雙擊鼠標(biāo)編輯對象ID_PICKSTYLE_OK 使用CC_setvar PICKSTYLE 0ID_PICKSTYLE_NO -不使用CC_setvar PICKSTYLE 1ID_ANGBASE 基準(zhǔn)角置零,圖案為Ansi31CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!modCADSysVariant.AngBaseIs0ID_ZOOMFACTOR 鼠標(biāo)輥掄縮放速度.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/鼠標(biāo)輥掄縮放速度.dvb!Module1.SFSDID_HPNAME 設(shè)置默認(rèn)填充圖案為ANSI31CC_setvar HPNAME ansi31ID_CELTSCALE 設(shè)置當(dāng)前對象的線型比例因子為1CC_setvar CELTSCALE 1 ID_QLHCHBC Windows系統(tǒng)工具ID_CALC 計算器. CTRL+SHIFT+ALT+ZCC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/winsystools.dvb!Module1.calcID_Mspaint 畫筆. CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/winsystools.dvb!Module1.mspaintID_CALC1 實(shí)用計算器.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/winsystools.dvb!Module1.calc1ID_ChangeWPaper 電話表ID_FDTel 公司電話表.CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/AcadVBA.dvb!modTel.FDTelID_ZHGTel 菜單ID_Update CAD2002菜單更新CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/UpdateFDMenu.dvb!Module1.Update02menuID_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)，因此不需要它做什么下一行的后面的這個CC-vbarun F:/編程/作品/CAD二次開發(fā)/二次開發(fā)/Vba計算/通信.dvb!Module1.TongXin 是我們點(diǎn)擊此菜單項(xiàng)所執(zhí)行的動作，前面的CC是相當(dāng)于按了兩次Esc鍵，主要是為了取消前一個正在運(yùn)行的命令，下面的-vbarun是運(yùn)行VBA程序的命令，再后面的的就是這個VBA宏文件的路徑和名稱了，如果將此宏文件的路徑加到CAD支持文件的搜索路徑內(nèi)，就可以去掉前面的路徑了。要注意的是在后面的行中的方括號內(nèi)有-和鼠標(biāo)中鍵控制ID_MButtonPan 鼠標(biāo)中鍵平移CC_setvar mbuttonpan 1ID_MButtonMenu 顯示文件對話框ID_filediaON 顯示CC_setvar filedia 1ID_filediaOFF -不顯示CC_setvar filedia 0ID_ZOOMFACTOR 鼠標(biāo)輥掄縮放速度.CC-vbarun c:/Tests.dvb!Module1.SFSDID_CALC 計算器.CC-vbarun C:/Tests.dvb!Module1.calcID_CIRCLE 畫圓.CC-vbarun C:/Tests.dvb!Module1.circlesID_MENUUPDATE 菜單更新CC-vbarun C:/Tests.dvb!Module1.updatemenus*TOOLBARS*HELPSTRINGSID_CALC 打開計算器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和frmMouseModule1里面的代碼為下面內(nèi)容：Option ExplicitDim MnuGroup As AcadMenuGroupPublic Enum enuLineType ltContinuous = 0 ltCenter = 1 ltDASHED = 2 ltPHANTOM = 3End EnumPublic Sub calc()Shell calc.exe, vbNormalFocusEnd SubPublic Sub SFSD()frmMouse.ShowEnd SubPublic Sub Circles()frmCircle.ShowEnd SubPublic Sub UpdateMenu()End Sub判斷圖層是否存在Public Function LayerExist(ByVal strLayerName As String) As BooleanDim objLayer As AcadLayerFor Each objLayer In ThisDrawing.Layers If objLayer.Name = strLayerName Then LayerExist = True Exit For End If NextEnd Function添加圖層Public Function AddLayers(ByVal strLayerName As String, LineType As enuLineType, lColor As ACAD_COLOR, lineWeight As AcLineWeight) As AcadLayerDim objLayer As AcadLayerOn Error GoTo LineErrorSet objLayer = ThisDrawing.Layers.Add(strLayerName)If LineTypeExist(LineType) = False Then ThisDrawing.Linetypes.Load GetLineTypeString(LineType), acadiso.lin 添加線型End IfobjLayer.LineType = GetLineTypeString(LineType)objLayer.color = lColorobjLayer.lineWeight = lineWeightSet AddLayers = objLayerExit FunctionLineError:MsgBox Err.Number & Chr(13) & Err.Description, 16End Function獲得圖層Public Function GetLayer(ByVal strLayerName As String) As AcadLayerDim objLayer As AcadLayerFor Each objLayer In ThisDrawing.Layers If objLayer.Name = strLayerName Then Set GetLayer = objLayer Exit For End If NextEnd Function判斷線型是否存在Private Function LineTypeExist(ByVal LineTypeName As enuLineType) As BooleanDim objLineType As AcadLineTypeFor Each objLineType In ThisDrawing.Linetypes If objLineType.Name = GetLineTypeString(LineTypeName) Then LineTypeExist = True Exit For End If NextEnd FunctionPrivate Function GetLineTypeString(ByVal LineType As 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 SelectEnd FunctionPublic Sub UpdateMenus()On Error Resume NextApplication.MenuGroups.Item(Test).UnloadApplication.MenuGroups.Load c:Test.mnsSet MnuGroup = Application.MenuGroups.Item(Test)MnuGroup.Menus.InsertMenuInMenuBar Test(&T), Application.MenuBar.Count + 1End SubfrmCircle的窗體內(nèi)容為窗體內(nèi)的代碼為：Option ExplicitDim dblPoints(2) As Double, dblR As DoublePrivate Sub cmdOK_Click()Dim objCircle As AcadCircleDim objLayer As AcadLayer, objOldLayer As AcadLayerDim dblStart(2) As Double, dblEnd(2) As Double, dblExtend As DoubledblPoints(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 IfSet 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 IfThisDrawing.ActiveLayer = objLayer 設(shè)置中心線層為當(dāng)前層dblStart(0) = dblPoints(0) - dblR - dblExtenddblStart(1) = dblPoints(1)dblStart(2) = dblPoints(2)dblEnd(0) = dblPoints(0) + db