0

我一直在尝试恢复现有的绘图检查宏，并希望找到每张纸上任何笔记块的坐标。我一直在使用此页面中的 GetAttachPos 方法修改此处找到的代码，但由于某种原因，返回的任何坐标都会返回 (8.80942311664557E-03,2.24429295226372E-03)。

我认为问题在于我在某处错过了参考，但我不确定在哪里。虽然它肯定会找到笔记，因为它会传回它们的文本。无论如何，这是我目前正在测试的方法：

Sub Main()

Dim swApp As SldWorks.SldWorks
Set swApp = CreateObject("SldWorks.Application")

Dim NoteNumbersText As String
Dim NoteText As String


Dim NumberofSheets As Integer                   ' The number of sheets in this drawing
Dim NamesOfSheets As Variant                    ' Names of all of the sheets
Dim sheet As SldWorks.sheet                     ' The Sheet that we are working on
Dim LocalView As SldWorks.View                  ' Current View that we are looking at
Dim LocalNote As SldWorks.Note                  ' Current Note that we are looking at

Dim TextFormat As SldWorks.TextFormat           ' Current text format object of a note
Dim Xpos As Double                              ' X, Y Z position on the drawing in Metres
Dim Ypos As Double
Dim SizeOfSheet As Double

Dim x As Integer                                ' general Loop Variables
Dim j As Integer
Dim k As Integer
Dim l As Integer

Dim vPosition As Variant

Dim vNote As Variant                            ' Single note
Dim swNote As SldWorks.Note                     ' Single Solidworks Note Object

Dim ThisAnnotation As SldWorks.Annotation
Dim swBlockInst As SldWorks.SketchBlockInstance
Dim swBlockDef As SldWorks.SketchBlockDefinition

Dim NumofNotes As Integer
Dim ArrayOfNotes() As NoteInfo

Dim LocalDrawingDoc As SldWorks.DrawingDoc        ' Declared as an Object so that non Drawings can be detected!
Dim LocalPart As SldWorks.ModelDoc2 ' Declared as an Object so that non Drawings can be detected!

Dim strShtProp As Variant

Set LocalDrawingDoc = swApp.ActiveDoc
Set LocalPart = swApp.ActiveDoc
ReDim ArrayOfNotes(0)
' Get the sheet names and the number of them
NamesOfSheets = LocalDrawingDoc.GetSheetNames()
NumberofSheets = LocalDrawingDoc.GetSheetCount

' store this sheet name
Set sheet = LocalDrawingDoc.GetCurrentSheet()
strShtProp = sheet.GetProperties() ' get the sheet properties use much later for converting position into ref
SizeOfSheet = strShtProp(5)

Dim SwSketchMgr As SldWorks.SketchManager
Set SwSketchMgr = LocalDrawingDoc.SketchManager

Dim i As Integer
Dim vBlockDef As Variant
Dim vBlockInst As Variant

Dim strReturn As String

'    Dim bret As Boolean

vBlockDef = SwSketchMgr.GetSketchBlockDefinitions

For x = NumberofSheets - 1 To 0 Step -1

    If LocalDrawingDoc.GetCurrentSheet.GetName <> NamesOfSheets(x) Then LocalDrawingDoc.ActivateSheet NamesOfSheets(x)

        Set LocalView = LocalDrawingDoc.GetFirstView
        While Not LocalView Is Nothing

            If Not IsEmpty(vBlockDef) Then
                For i = 0 To UBound(vBlockDef)
                    Set swBlockDef = vBlockDef(i)

                    vBlockInst = swBlockDef.GetInstances
                    vNote = swBlockDef.GetNotes

                    If Not IsEmpty(vNote) Then

                        For j = 0 To UBound(vNote)
                            Set swNote = vNote(j)

                            NoteNumbersText = Trim(swNote.GetText)

                            If Left(NoteNumbersText, 1) = "n" And Len(NoteNumbersText) > 1 And Len(NoteNumbersText) < 4 Then
                                Set ThisAnnotation = swNote.GetAnnotation
                                'vPosition = swNote.GetAttachPos
                                vPosition = ThisAnnotation.GetPosition
                                Xpos = vPosition(0)
                                Ypos = vPosition(1)

                                Debug.Print ("Note " & NoteNumbersText & ": " & Xpos & "," & Ypos)


                            End If

                        Next j
                    End If
                Next i
           End If

        Set LocalView = LocalView.GetNextView
        Wend



Next x

End Sub
4

1 回答 1

0

事实证明，SolidWorks 设置为返回块相对于放置它们的工程图视图的位置。为放置它们的视图调用 GetXForm 然后提供了一种计算每个音符的绝对位置的方法。

于 2011-09-28T11:55:15.587 回答