|
|
Option Explicit
Const pi = 3.14159
Dim point(0 To 2) As Double, point2(0 To 2) As Double
Dim textposition(0 To 2) As Double
Dim center(0 To 2) As Double, radius As Double
Dim offset As Double
Private Sub cmdexit_click()
Unload Me
End Sub
Private Sub userform_initialize()
point1(0) = 1#: point1(1) = 1#: point1(2) = 0#
point2(0) = 5#: point2(1) = 1#: point2(2) = 0#
offset = 0.25
textposition(0) = 2#
textposition(1) = 1# + offset
textposition(2) = 0#
center(0) = 0#: center(1) = 0#: center(2) = 0#
radius = 2#
End Sub
Private Sub opt3pointangular_Click()
Dim dimensionobject As AcadDim3PointAngular
Dim circleobject As AcadCircle
Dim firstendpoint(0 To 2) As Double
Dim secondendpoint(0 To 2) As Double
Set circleobject = ThisDrawing.ModelSpace.AddCircle(center, radius)
circleobject.Update
firstendpoint(0) = center(0) + radius
firstendpoint(1) = center(1)
firstendpoint(2) = center(2)
secondendpoint(0) = center(0) + radius * Cos(45 * pi / 180)
secondendpoint(1) = center(1) + radius * Sin(45 * pi / 180)
secondendpoint(2) = center(2)
Set dimensionobject = ThisDrawing.ModelSpace.AddDim3PointAngular _
(center, firstendpoint, secondendpoint, textposition)
dimensionobject.AngleFormat = acDegrees
dimensionobject.Update
ZoomAll
End Sub
Private Sub optangular_Click()
Dim dimensionobject As AcadDimAngular
Dim circleobject As AcadCircle
Dim firstendpoint(0 To 2) As Double
Dim secondendpoint(0 To 2) As Double
Set circleobject = thhisdrawing.ModelSpace.AddCircle(center, radius)
circleobject.Update
firstendpoint(0) = center(0) + radius
firstendpoint(1) = center(1)
firstendpoint(2) = center(2)
secondendpoint(0) = center(0) + radius * Cos(45 * pi / 180)
secondendpoint(1) = center(1) + radius * Sin(45 * pi / 180)
secondendpoint(2) = center(2)
Set dimensionobject = ThisDrawing.ModelSpace.AddDimAngular _
(center, firstendpoint, secondendpoint, textposition)
dimensionobject.AngleFormat = acDegrees
dimensionobject.Update
ZoomAll
End Sub
Private Sub optdiametric_Click()
Dim dimensionobject As AcadDimDiametric
Dim lineobject As AcadLine
Dim circleobject As AcadCircle
Dim chordpoint(0 To 2) As Double, farchordpoint(0 To 2) As Double
Set circleobject = ThisDrawing.ModelSpace.AddCircle(center, radius)
circleobject.Update
chordpoint(0) = center(0) + radius * Cos(45 * pi / 180)
chordpoint(1) = center(1) + radius * Sin(45 * pi / 180)
chordpoint(2) = center(2)
farchordpoint(0) = center(0) + radius * Cos(225 * pi / 180)
farchordpoint(1) = center(1) + radius * Sin(225 * pi / 180)
farchordpoint(2) = center(2)
Set lineobject = ThisDrawing.ModelSpace.AddLine(chordpoint, farchordpoint)
lineobject.Update
Set dimensionobject = ThisDrawing.ModelSpace.AddDimDiametric _
(chordpoint, farchordpoint, 1.5)
dimensionobject.Update
ZoomAll
End Sub
Private Sub optordinate_Click()
Dim dimensionobject As AcadDimOrdinate
Dim lineobject As AcadLine
Dim definitionpoint(0 To 2) As Double
Dim leaderendpoint(0 To 2) As Double
Set lineobject = ThisDrawing.ModelSpace.AddLine(point1, point2)
lineobject.Update
definitionpoint(0) = (point1(0) + point2(0)) / 2#
definitionpoint(1) = (point1(1) + point2(1)) / 2#
definitionpoint(2) = (point1(2) + point2(2)) / 2#
leaderendpoint(0) = definitionpoint(0)
leaderendpoint(1) = definitionpoint(1) + 2#
leaderendpoint(2) = definitionpoint(2)
Set dimensionobject = ThisDrawing.ModelSpace.AddDimOrdinate _
(definitionpoint, leaderendpoint, True)
dimensionobject.ExtensionLineOffset = offset
dimensionobject.Update
ZoomAll
End Sub
Private Sub optradial_Click()
Dim dimensionobject As AcadDimRadial
Dim circleobject As AcadCircle
Dim lineobject As AcadLine
Dim chordpoint(0 To 2) As Double
Set circleobject = ThisDrawing.ModelSpace.AddCircle(center, radius)
circleobject.Update
chordpoint(0) = center(0) + radius
chordpoint(1) = center(1)
chordpoint(2) = center(2)
Set lineobject = ThisDrawing.ModelSpace.AddLine(center, chordpoint)
lineobject.Update
Set dimensionobject = ThisDrawing.ModelSpace.AddDimRadial(center, chordpoint, 1.25)
dimensionobject.Update
ZoomAll
End Sub
Private Sub optrotated_Click()
Dim dimensionobject As AcadDimRotated
Dim lineobject As AcadLine
Dim dimlinelocation(0 To 2) As Double
dimlinelocation(0) = point1(0) - 1#
dimlinelocation(1) = point1(1)
dimlinelocation(2) = point1(2)
Set lineobject = ThisDrawing.ModelSpace.AddLine(point1, point2)
lineobject.Update
Set dimensionobject = ThisDrawing.ModelSpace.AddDimRotated _
(point1, point2, dimlinelocation, (45 * pi / 180))
dimensionobject.Update
ZoomAll
End SubPrivate Sub optaligned_Click()
Dim dimensionobject As AcadDimAligned
Dim lineobject As AcadLine
Set lineobject = ThisDrawing.ModelSpace.AddLine(point1, point2)
lineobject.Update
Set dimensionobject = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, textposition)
dimensionobject.ExtensionLineOffset = offset
dimensionobject.ArrowheadSize = 0.5
dimensionobject.Color = acCyan
ThisDrawing.Preferences.LineWeightDisplay = True
dimensionobject.DimensionLineWeight = acLnWt030
dimensionobject.Update
ZoomAll
End Sub |
|
置顶卡
