方法 AddItems 範例

本範例會建立一個名稱為 TEST_SELECTIONSET 的選集，並在模型空間內劃上幾個元件，然後將模型空間內的所有元件都加入到選集內。 選集的名稱不可以重複，它在關閉檔案後就會自動消失，下次再開啟檔案時也不會存在。 Sub Example_AddItems()     ' 建立一個名稱為 TEST_SELECTIONSET 的選集     Dim ssetObj As AcadSelectionSet     Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SELECTIONSET")     ' 模型空間內畫一個射線元件     Dim rayObj As AcadRay     Dim basePoint(0 To 2) As Double     Dim SecondPoint(0 To 2) As Double     basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#     SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#     Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)     ' 模型空間內畫一個聚合線元件     Dim plineObj As AcadLWPolyline     Dim points(0 To 5) As Double     points(0) = 3: points(1) = 7     points(2) = 9: points(3) = 2     points(4) = 3: points(5) = 5     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)     plineObj.Closed = True     ' 模型空間內畫一線元件     Dim lineObj As AcadLine     Dim startPoint(0 To 2) As Double     Dim endPoint(0 To 2) As Double     startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0     endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)     ' 模型空間內畫一個圓元件     Dim circObj As AcadCircle     Dim centerPt(0 To 2) As Double     Dim radius As Double     centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0     radius = 3     Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)     ' 模型空間內畫一個橢圓元件     Dim ellObj As AcadEllipse     Dim majAxis(0 To 2) As Double     Dim center(0 To 2) As Double     Dim radRatio As Double     center(0) = 5#: center(1) = 5#: center(2) = 0#     majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#     radRatio = 0.3     Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)     '縮放全部     ZoomAll         ' 模型空間內的所有元件全部收集到陣列內。     ReDim ssobjs(0 To ThisDrawing.ModelSpace.Count - 1) As AcadEntity     Dim I As Integer     For I = 0 To ThisDrawing.ModelSpace.Count - 1         Set ssobjs(I) = ThisDrawing.ModelSpace.Item(I)     Next     ' 將陣列內的所有元件加入到選集內。     ssetObj.AddItems ssobjs     ' 重生目前視埠。     ThisDrawing.Regen acActiveViewport End Sub

方法 IntersectWith 範例

Sub Example_IntersectWith()     ' 本範例會先在圖面上畫一條線及一個圓，然後顯示出兩個元件的交叉點     '宣告線所需的變數     Dim lineObj As AcadLine     Dim startPt(0 To 2) As Double     Dim endPt(0 To 2) As Double     '指定線的起始點     startPt(0) = 1: startPt(1) = 1: startPt(2) = 0     '指定線的結束點     endPt(0) = 10: endPt(1) = 10: endPt(2) = 0     '在圖面上畫線     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)     '宣告圓所需的變數     Dim circleObj As AcadCircle     Dim centerPt(0 To 2) As Double     Dim radius As Double     '指定圓的中心點     centerPt(0) = 5: centerPt(1) = 5: centerPt(2) = 0     '指定圓的半徑     radius = 1     '在圖面上畫圓     Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)     '縮放實際範圍     ZoomExtents     Dim intPoints As Variant     '找出線與圓的交叉點     'acExtendNone 意思為是不延伸元件     intPoints = lineObj.IntersectWith(circleObj, acExtendNone)     Dim I As Integer, j As Integer, k As Integer     Dim str As String     '如果兩個元件沒有交叉則變數 intPoints 將會未被初始化     If VarType(intPoints) <> vbEmpty Then         For I = LBound(intPoints) To UBound(intPoints)             str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," _                 & intPoints(j + 1) & "," & intPoints(j + 2)             MsgBox str, , "IntersectWith Example"             str = ""             I = I + 2             j = j + 3             k = k + 1         Next     End If End Sub

事件 Activate 範例

Private Sub AcadDocument_Activate()     ' 將本範例貼在 ThisDrawing 物件的程式碼區內     ' 會於切換文件檔案時觸發本事件     MsgBox "You have just activated a drawing!" End Sub

方法 Activate 範例

Sub Example_ActivateMethod()     ' 本範例建立兩個空白文件並依序讓所有的文件處於作用中的文件     Dim NewDrawing1 As AcadDocument     Dim Newdrawing2 As AcadDocument     Set NewDrawing1 = ThisDrawing.Application.Documents.Add("")     Set Newdrawing2 = ThisDrawing.Application.Documents.Add("")         Dim drawing As AcadDocument     For Each drawing In ThisDrawing.Application.Documents         drawing.Activate         MsgBox "Drawing " & drawing.name & " is active."     Next drawing End Sub

屬性 ActiveLayer 範例

Sub Example_ActiveLayer()     ' 本範例將會傳回目前的圖層，再增加一個新的圖層並將新增的圖層     '設為「使用中的圖層」，最後會將「使用中的圖層」設為原本的圖層     Dim currLayer As AcadLayer     Dim newLayer As AcadLayer         ' 傳回目前文件內「使用中的圖層」     Set currLayer = ThisDrawing.ActiveLayer     MsgBox "The current layer is " & currLayer.name, vbInformation, "ActiveLayer Example"         ' 建立一個新的圖層並將它設為「使用中的圖層」     Set newLayer = ThisDrawing.Layers.Add("TestLayer")     ThisDrawing.ActiveLayer = newLayer     MsgBox "The new layer is " & newLayer.name, vbInformation, "ActiveLayer Example"     ' 回復「使用中的圖層」為原本的圖層     ThisDrawing.ActiveLayer = currLayer     MsgBox "The active layer is reset to " & currLayer.name, vbInformation, "ActiveLayer Example" End Sub

屬性 ActiveDocument 範例

Sub Example_ActiveDocument()    Dim activeDoc As AcadDocument    ' 傳回 AutoCad 目前使用中的文件    Set activeDoc = ThisDrawing.Application.ActiveDocument    MsgBox "The active document is: " & activeDoc.name, VbInformation, "ActiveDocument Example" End Sub

屬性 ActiveDimStyle 範例

Sub Example_ActiveDimStyle()     Dim newDimStyle As AcadDimStyle     Dim currDimStyle As AcadDimStyle         ' 傳回文件中的「目前的標註型式」     Set currDimStyle = ThisDrawing.ActiveDimStyle     MsgBox "The current dimension style is " & currDimStyle.name, vbInformation, "ActiveDimStyle Example"         '建立一個標註型式並將它設置為「目前的標註型式」     Set newDimStyle = ThisDrawing.DimStyles.Add("TestDimStyle")     ThisDrawing.ActiveDimStyle = newDimStyle       ' 將 newDimStyle 設為「目前的標註型式」     MsgBox "The new dimension style is " &newDimStyle.name, vbInformation, "ActiveDimStyle Example"         '將「目前的標註型式」改回原來所使用的標註型式     ThisDrawing.ActiveDimStyle = currDimStyle     MsgBox "The dimension style is reset to " & currDimStyle.name, vbInformation, "ActiveDimStyle Example" End Sub

屬性 Active 範例

Sub Example_Active()     ' 本範例建立兩個空白文件並顯示哪個文件才是目前使用中的文件    Dim NewDrawing1 As AcadDocument    Dim Newdrawing2 As AcadDocument    Set NewDrawing1 = ThisDrawing.Application.Documents.Add("")    Set Newdrawing2 = ThisDrawing.Application.Documents.Add("")    Dim activeStatus As String    Dim drawing As AcadDocument    activeStatus = ""    For Each drawing In ThisDrawing.Application.Documents       If drawing.Active Then          activeStatus = activeStatus & drawing.name & " is active." & vbCrLf       Else          activeStatus = activeStatus & drawing.name & " is not active." & vbCrLf       End If    Next drawing    MsgBox activeStatus End Sub

屬性 Action 範例

Sub Example_Action()     ' 本範例加密並儲存檔案     Dim acad As New AcadApplication     Dim sp As New AcadSecurityParams     acad.Visible = True     sp.Action = AcadSecurityParamsType.ACADSECURITYPARAMS_ENCRYPT_DATA     sp.Algorithm = AcadSecurityParamsConstants.ACADSECURITYPARAMS_ALGID_RC4     sp.KeyLength = 40     sp.Password = UCase("mypassword") '將密碼轉換為大寫英文字母     sp.ProviderName = "Microsoft Base Cryptographic Provider v1.0"     sp.ProviderType = 1     acad.ActiveDocument.SaveAs "C:\MyDrawing.dwg", , sp End Sub