无法获得音符块的合理坐标

时间:2011-09-22 09:49:43

标签: vba solidworks

我一直试图恢复现有的绘图检查宏,并想要找到每张纸上任何注释块的坐标。我一直在使用来自here的GetAttachPos方法修改找到this page的代码,但出于某种原因,任何返回的坐标都会回来(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

1 个答案:

答案 0 :(得分:0)

原来,SolidWorks设置为返回块相对于放置它们的图纸视图的位置。为其放置的视图调用GetXForm然后提供一种计算每个音符的绝对位置的方法。