Witam
Opracowuję makro, które tworzy nasze rysunki do cięcia laserowego z obrabianego przedmiotu.
W większości jest funkcjonalny, ale wciąż mam część do sfinalizowania dotyczącą oceny kranów.
Chciałbym, aby moje makro wybierało okręgi mojego widoku 1 na 1, a następnie, jeśli jest to stuknięcie (i tylko jeśli jest to stuknięcie), bok w tej postaci M10 lub jeśli nie jest to niestandardowe M10x1 (patrz przykład poniżej)
Na razie udaje mi się dzięki makrowi (pobrane tutaj) wybrać okręgi, ale utknąłem na części cytatu, odzyskałem jeden lub 2 kody na objaśnieniu otworu, ale wiele z nich nie działa nawet w odzyskanej wersji.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim Comp As SldWorks.Component2
Dim vComps As Variant
Dim vComp As Variant
Dim vEdges As Variant
Dim vEdge As Variant
Dim swEdge As SldWorks.Edge
Dim swCurve As SldWorks.Curve
Dim swEntity As SldWorks.Entity
Dim CurveParam As Variant
Dim IsClosed As Boolean
Dim Diameter As Double
Dim boolstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.ActiveDrawingView
swModel.ClearSelection2 True
vComps = swView.GetVisibleComponents
'Diameter = InputBox("Entrer le diamètre en mm")
For Each vComp In vComps
Set Comp = vComp
vEdges = swView.GetVisibleEntities(Comp, swViewEntityType_e.swViewEntityType_Edge)
For Each vEdge In vEdges
Set swEdge = vEdge
Set swCurve = swEdge.GetCurve
If swCurve.IsCircle Then
swCurve.GetEndParams Empty, Empty, IsClosed, Empty
If IsClosed Then
CurveParam = swCurve.CircleParams
'If Abs(Diameter - CurveParam(6) * 2 * 1000) < 0.0001 Then
Set swEntity = swEdge
swEntity.Select4 True, Nothing
'ici le code pour cotation avec hole callout
'End If
End If
End If
Next
Next
'swModel.SetLineColor 255
swModel.ClearSelection2 True
End Sub