Не могу получить разумные координаты для блоков заметок - PullRequest
Новая
       8

Не могу получить разумные координаты для блоков заметок

0 голосов
/ 22 сентября 2011

Я пытался воскресить существующий макрос проверки чертежа и хочу найти координаты любых блоков заметок на каждом листе. Я модифицировал найденный код здесь , используя метод 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

1 Ответ

0 голосов
/ 28 сентября 2011

Оказывается, что SolidWorks настроен на возврат позиций блоков относительно чертежа, на котором они размещены. Вызов GetXForm для представления, в котором они размещены, позволяет рассчитать абсолютную позицию каждой ноты.

...