经典图书 识别图纸,通过按钮实现粗糙度在图纸右上角自动标注。但当宏程序第一次运行时会出现粗糙度带引线的情况,删除该粗糙度后,再次运行就不会出现。不知道问题出现在哪,求帮助。
详细代码如下:
Private Sub CommandButton30_Click()
'粗糙度其余6.3
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim mySFSymbol As Object
Set swApp = Application.SldWorks
Set swmodel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set swdraw = swApp.ActiveDoc
Set swSheet = swdraw.GetCurrentSheet
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
vSheetProps = swSheet.GetProperties
TemplateName = swSheet.GetTemplateName
ppapersize = vSheetProps(0)
If ppapersize = 6 Then
Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 1, 0.275, 0.195, 0, 0, 1, "其余", "", "", "", "", "6.3", "")
ElseIf ppapersize = 7 Then
Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 1, 0.189, 0.281, 0, 0, 1, "其余", "", "", "", "", "6.3", "")
ElseIf ppapersize = 8 Then
Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 1, 0.398, 0.281, 0, 0, 1, "其余", "", "", "", "", "6.3", "")
ElseIf ppapersize = 9 Then
Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 1, 0.567, 0.399, 0, 0, 1, "其余", "", "", "", "", "6.3", "")
End If
Part.ViewZoomtofit2
End Sub |