VBA-创建标注样式
你好我正在尝试使用VBA Excel创建标注样式。我有一个简单的代码如下:
Option Explicit
Sub New_Layer()
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
Dim mSp As AcadModelSpace
Dim dimstyle As AcadDimStyle
Dim sDim As AcadDimAligned
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim location(0 To 2) As Double
'Check if AutoCAD is open.
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
Set acadApp = New AcadApplication
acadApp.Visible = True
End If
'Check if there is an active drawing.
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0
'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
Set acadDoc = acadApp.Documents.Add
acadApp.Visible = True
End If
Set mSp = acadDoc.ModelSpace
'Dimension points
point1(0) = 0#: point1(1) = 5#: point1(2) = 0#
point2(0) = 6.1: point2(1) = 5: point2(2) = 0#
location(0) = 5#: location(1) = 4.4: location(2) = 0#
'Add dimension
Set sDim = acadDoc.ModelSpace.AddDimAligned(point1, point2, location)
'Set dimension properties
sDim.Color = acByLayer
sDim.ExtensionLineExtend = 0
sDim.Arrowhead1Type = acArrowOblique
sDim.Arrowhead2Type = acArrowOblique
sDim.ArrowheadSize = 0.1
sDim.TextColor = acGreen
sDim.TextHeight = 0.2
sDim.UnitsFormat = acDimLDecimal
sDim.PrimaryUnitsPrecision = acDimPrecisionOne
sDim.TextGap = 0.1
sDim.LinearScaleFactor = 100
sDim.ExtensionLineOffset = 0.1
sDim.VerticalTextPosition = acOutside
'Create a new dimension style
Set dimstyle = acadDoc.DimStyles.Add("D100")
'Copy dimension properties from previously added dimension
dimstyle.CopyFrom (sDim)
'Delete dimension
sDim.Delete
End Sub
然而
dimstyle.CopyFrom (sDim)线路不工作。我遇到以下错误:“对象不支持此属性或方法”
我找不到我做错了什么。我正在使用AutoCAD 2013和Excel 2016。
非常感谢。 使用dimstyle。从sDim复制,而不是dimstyle。CopyFrom(sDim)解决了我的问题。这很容易。很抱歉发布此消息。 有趣的代码-它显示了创建维度样式的完全activex方法。
在创建新的dim样式之前,我只熟悉预先设置某些系统变量和命令调用。
因此,这种方法将被复制到您的代码中:(vla SetVariable acaddoc…)将被使用。 有趣的是,当谷歌搜索同一个任务时,可以看到lisp v的VBA,Grr Setvariable是VBA中支持的方法。
还记得看到一个entmake,其中包含某个地方描述的每个变量。
页:
[1]