Makro do wybierania położenia ramki na rysunku

Cze wszystkim

Obecnie tworzę przyciski makr do wstawiania bloków w tło rysunku.

Jak na razie nic skomplikowanego, mam kod, który działa bardzo dobrze:

Ustaw swApp = _
Aplikacja.SldWorks

Ustaw część = swApp.ActiveDoc
Part.EditTemplate (Szablon części)
Part.EditSketch
Dim myBlockDefinition As Obiekt
Set myBlockDefinition = Part.SketchManager.MakeSketchBlockFromFile(Nothing, "D:\_MAIA\1_MODELES\4_BLOCS-BUFFERS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0)
Part.EditSheet (Arkusz edycji)
Part.EditSketch
Koniec subwoofera

 

Mój problem dotyczy położenia bloku na rysunku, chciałbym mieć możliwość predefiniowania pozycji w moim kodzie (w X i Y).

Obecnie, gdy uruchamiam makro, blok mieści się w lewym dolnym rogu rysunku.

Próbowałem wielu rzeczy, ale bez powodzenia.

Jeśli ktoś wie coś o VBA to jestem zainteresowany ;-)

Z góry dzięki,

Pozdrowienia.

 

1 polubienie

Witam

W rzeczywistości pierwszym argumentem metody MakeSketchBlockFromFile jest pozycja!

W twoim przykładzie umieściłeś "nic", więc myślę, że domyślnie mieści się w punkcie kontrolnym twojego rysunku.

Masz więc dwa rozwiązania: zmień punkt kontrolny swoich szablonów rysunków lub zmodyfikuj to nic, aby wybrać punkt w następujący sposób:

Punkt wstawiania
Punkt wstawienia, który musi być punktem 2D o wartości z = 0,0 dla definicji bloku
 

Odpowiednia strona: 

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.interop.sldworks~SolidWorks.interop.sldworks.ISketchManager~MakeSketchBLockFromFile.html

3 polubienia

Przede wszystkim dziękuję za pomoc.

Nie chcę dotykać moich modeli

Nie wiem jednak, jak przepisać tę nową linię do mojego kodu.

 Do czego powróci? Gdzie powinienem go umieścić?

Czy w X i Y są współrzędne?

Z góry dziękuję

1 polubienie

Więc zanim wstawisz swój blok, będziesz musiał utworzyć i nazwać swój punkt wstawiania, którego będziesz używać zamiast swojego "nic", zobacz ten link, aby utworzyć punkt:

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IMathPoint.html

Więcej szczegółów do utworzenia punktu:

 'Utwórz nowy MathPoint na podstawie danych punktu szkicu.

    'MathP odnosi się do położenia punktu we współrzędnych szkicu

    Ustaw MathP = MathUtil.CreatePoint(Współrzędne punktu)

    'Wyświetlanie współrzędnych punktu w odniesieniu do początku układu współrzędnych szkicu

    SketchPoints = Dane MathP.ArrayData

    MsgBox SketchPoints(0) & ", " & SketchPoints(1) & ", " & SketchPoints(2)

http://help.solidworks.com/2012/English/api/sldworksapi/Transform_Sketch_to_Model_Example_VB.htm

 

2 polubienia

Przyznaję się, że jestem zagubiony...

Oto, co zrobiłem, ale bez żadnych rezultatów:

 

Ustaw swApp = _
Aplikacja.SldWorks

Ustaw część = swApp.ActiveDoc
Part.EditTemplate (Szablon części)
Part.EditSketch

Ustaw MathP = MathUtil.CreatePoint(Współrzędne punktu)
SketchPoints = MathP.ArrayData

    MsgBox SketchPoints(0) & "5.0" & SketchPoints(1) & "5.0" & SketchPoints(2)


Dim myBlockDefinition As Obiekt
Set myBlockDefinition = Part.SketchManager.MakeSketchBlockFromFile(Nothing, "D:\_MAIA\1_MODELES\4_BLOCS-BUFFERS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0)
Part.EditSheet (Arkusz edycji)
Part.EditSketch
Part.ClearSelection2 Prawda
Koniec subwoofera

W Twojej linii:

Part.SketchManager.MakeSketchBlockFromFile(Nothing, "D:\_MAIA\1_MODELES\4_BLOCS-BUFFERS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0)

 

Nadal używasz Nothing

Jak już mówiłem, musimy zastąpić to punktem wstawiania!

A w Twojej linii:

SketchPoints = MathP.ArrayData

Nie podałeś współrzędnych.

 

Czy znasz się na programowaniu w języku vba?

1 polubienie

Być może istnieje bardziej wymowny przykład, który może Ci w tym pomóc:

'NOWE BLOKI: Utwórz definicję bloku

    Ustaw swSketchBlockDef = swSketchMgr.MakeSketchBlockFromSelected(Nothing)

    '

    ' Definiowanie punktu wstawienia

    nPt(0) = 60# / 1000#

    nPt(1) = -60# / 1000#

    nPt(2) = 0#

    vPt = nPt

    Ustaw swMathPoint = swMathUtil.CreatePoint(vPt)

    '

    ' Wstawianie wystąpienia definicji bloku

    Set swBlockInst = swSketchMgr.InsertSketchBlockInstance(swSketchBlockDef, swMathPoint, 1, 0)

http://help.solidworks.com/2013/English/api/sldworksapi/Create_Block_Definition_and_Insert_Block_Instance_Example_VB.htm

1 polubienie

Na koniec zmieniłem punkty kotwiczenia bloków.

Merici  PL

1 polubienie

Witaj Bec2

W jaki sposób zmieniliście zakotwiczenie tych systemów?

Ponieważ nie znam się za dużo na VBA i na razie majstrowałem, aby mój blok przyszedł, ale nie ustawia się we właściwym miejscu.

Witam @sebastien_higaxo5742 .

Oto makro Vba do wstawiania bloku, wybierając jego punkty współrzędnych:

Dim swApp As Object
Dim swModel As Object
Dim swDrawing As Object
Dim swSheet As Object
Dim swBlockDef As Object
Dim swBlockIns As Object

Sub InsertBlockAtPoint()

    ' Se connecter à l'application SolidWorks
    Set swApp = Application.SldWorks

    ' Obtenir le document actif (supposé être un dessin)
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "Veuillez ouvrir un document de dessin."
        Exit Sub
    End If

    ' Vérifier si le document actif est un dessin
    If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
        MsgBox "Le document actif n'est pas un dessin."
        Exit Sub
    End If

    Set swDrawing = swModel

    ' Obtenir la feuille active
    Set swSheet = swDrawing.GetCurrentSheet

    ' Spécifier le chemin vers la définition du bloc
    Dim blockPath As String
    blockPath = "C:\Chemin\Vers\Votre\Bloc.sldblk" ' Changez ceci par le chemin de votre bloc

    ' Charger la définition du bloc
    Set swBlockDef = swDrawing.LoadBlockDefinition(blockPath)

    If swBlockDef Is Nothing Then
        MsgBox "Échec du chargement de la définition du bloc."
        Exit Sub
    End If

    ' Définir les coordonnées du point d'insertion
    Dim insertPoint(2) As Double
    insertPoint(0) = 0.1 ' Coordonnée X en mètres
    insertPoint(1) = 0.1 ' Coordonnée Y en mètres
    insertPoint(2) = 0    ' Coordonnée Z (généralement 0 pour les dessins 2D)

    ' Insérer le bloc au point spécifié
    Set swBlockIns = swSheet.InsertBlock(swBlockDef, insertPoint)

    If swBlockIns Is Nothing Then
        MsgBox "Échec de l'insertion du bloc."
    Else
        MsgBox "Bloc inséré avec succès."
    End If

End Sub

Następnie kilka uwag do kolejnych próśb:

Unikaj wykopywania ofert pracy 2016 Resolute w przyszłości... Zwłaszcza, jeśli któryś z autorów nie publikował ostatnio.

image

1 polubienie