粗糙度自动右上角标注，但当运行时偶尔会出现粗糙度带引线，不知道怎么解决

sunshine0099 · 发表于 2024-6-23 22:55:55

经典图书

识别图纸，通过按钮粗糙度在图纸右上角自动标注。但当第一次运行时会出现粗糙度带引线的情况，删除该粗糙度后，再次运行就不会出现。不知道问题出现在哪，求帮助。

qxzch · 发表于 2024-9-4 09:03:28

在插入粗糙度符号之前加一句“Part.ForceRebuild3 False”就可以

934561127 · 发表于 2024-6-27 13:45:41

经典图书

已经改好！

沉默的人 · 发表于 2024-6-24 08:25:33

楼主最好把宏发出来看来代码才知道

董东咚 · 发表于 2024-6-24 08:32:09

经典案例图书

SW机械工程师网，找到组织了！

sunshine0099 · 发表于 2024-6-24 08:48:46

沉默的人发表于 2024-6-24 08:25
楼主最好把宏发出来看来代码才知道

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

sunshine0099 · 发表于 2024-6-24 08:50:28

经典案例图书

沉默的人发表于 2024-6-24 08:25
楼主最好把宏发出来看来代码才知道

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

sunshine0099 · 发表于 2024-6-24 08:52:41

宏代码如下：
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

第一次运行宏的时候会出现粗糙度有引线。删除后粗糙度，再次运行就不会出现。而且只要不关闭当前宏在新建工程图中也不会出现粗糙度带引线。

sunshine0099 · 发表于 2024-6-24 13:58:00

代码如下：
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

baochen · 发表于 2024-6-26 18:48:52

经典图书

很不错，顶一下！

934561127 · 发表于 2024-6-27 10:44:12

原因是你点了图纸，不点击图纸不会出现引线~~

934561127 · 发表于 2024-6-27 13:43:36

Sub main()
'粗糙度其余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, 0, 0.275, 0.195, 0, 0, 10, "其余", "", "", "", "", "6.3", "")
ElseIf ppapersize = 7 Then
      Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 0, 0.189, 0.281, 0, 0, 10, "其余", "", "", "", "", "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
这样就可以

sunshine0099 · 发表于 2024-7-7 23:17:13

934561127 发表于 2024-6-27 13:45
已经改好！

你是把这个指令中由
Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 0, 0.275, 0.195, 0, 0, 10, "其余", "", "", "", "", "6.3", "")
改成
Set mySFSymbol = Part.Extension.InsertSurfaceFinishSymbol3(1, 1, 0.275, 0.195, 0, 0, 10, "其余", "", "", "", "", "6.3", "")

结果是鼠标点一次，在运行宏就会出现在上次鼠标点击的位置。
我是想让粗糙度识别图框大小后，运行宏，粗糙度在图框右上角固定位置显示。

liyuyin007 · 发表于 2024-9-4 17:13:15

楼主很专业，写得很好！

sunshine0099 · 发表于 2024-9-4 21:10:59

加入QQ群
参与讨论和学习

或扫描二维码加入

qxzch 发表于 2024-9-4 09:03
在插入粗糙度符号之前加一句“Part.ForceRebuild3 False”就可以

大神就是牛

氕氘氚 · 发表于 2024-9-9 10:47:04

经典案例图书

请问一下楼主，修改粗糙度样式在哪边修改呢，感谢

liyuyin007 · 发表于 2024-9-9 16:08:56

加入QQ群
参与讨论和学习

或扫描二维码加入

活到老学到老！

deihc851209 · 发表于 2024-10-12 10:01:49

经典案例图书

楼主可以分享一下这个工具吗，谢谢

3869 · 发表于 2024-11-20 10:55:40

楼主可以分享一下这个工具吗，谢谢

coke681 · 发表于 2024-12-3 14:30:54

很好！活到老学到老！

		自动登录	找回密码
密码			立即注册

粗糙度自动右上角标注，但当运行时偶尔会出现粗糙度带引线，不知道怎么解决

浏览过的版块

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献