Macro om de positie van een kader in een tekening te kiezen

Hoi allemaal

Ik ben momenteel bezig met het maken van macroknoppen om blokken in de achtergrond van een tekening in te voegen.

Tot zover niets ingewikkelds, ik heb een code die heel goed werkt:

Stel swApp in = _
Toepassing.SldWorks

Deel instellen = swApp.ActiveDoc
Deel.EditTemplate
Deel.EditSketch
Dim myBlockDefinition als object
Set myBlockDefinition = Part.SketchManager.MakeSketchBlockFromFile(Niets, "D:\_MAIA\1_MODELES\4_BLOCS-BUFFERS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0)
Deel.EditSheet
Deel.EditSketch
Einde Sub

 

Mijn probleem betreft de positie van het blok op de tekening, ik zou graag een positie in mijn code kunnen voordefiniëren (in X en Y).

Momenteel, wanneer ik de macro start, past het blok in de linkerbenedenhoek van de tekening.

Ik heb veel dingen geprobeerd, maar zonder succes.

Als iemand iets weet over VBA ben ik geïnteresseerd ;-)

Bij voorbaat dank,

Vriendelijke groeten.

 

1 like

Hallo

In feite is het eerste argument van uw MakeSketchBlockFromFile-methode de positie!

In je voorbeeld zet je "niets", dus ik denk dat het standaard past op het ankerpunt van je tekening.

Je hebt dus twee oplossingen: verander het ankerpunt van je tekensjablonen, of wijzig dit niets om je punt als volgt te kiezen:

Invoegen Punt
Invoegpunt, dat een 2D-punt moet zijn met z = 0,0, voor de blokdefinitie
 

De bijbehorende pagina: 

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

3 likes

Allereerst bedankt voor je hulp.

Ik wil mijn modellen niet aanraken

Ik weet echter niet hoe ik deze nieuwe regel naar mijn code moet transcriberen.

 Waarnaar zal het terugkeren? Waar moet ik het neerzetten?

Zijn er coördinaten in X en Y?

Bij voorbaat dank

1 like

Dus voordat u uw blok invoegt, moet u uw invoegpunt maken en een naam geven dat u zult gebruiken in plaats van uw "niets", zie deze link om het punt te maken:

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

Meer details om het punt te maken:

 'Maak de nieuwe MathPoint op basis van de schetspuntgegevens.

    'MathP verwijst naar de puntlocatie in de schetscoördinaten

    Stel MathP in = MathUtil.CreatePoint(PuntCoorden)

    'Geef de puntcoördinaten weer in relatie tot de oorsprong van de schets

    SketchPoints = 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 likes

Ik geef toe dat ik verdwaald ben...

Dit is wat ik deed, maar zonder enig resultaat:

 

Stel swApp in = _
Toepassing.SldWorks

Deel instellen = swApp.ActiveDoc
Deel.EditTemplate
Deel.EditSketch

Stel MathP in = MathUtil.CreatePoint(PuntCoorden)
SketchPoints = MathP.ArrayData

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


Dim myBlockDefinition als object
Set myBlockDefinition = Part.SketchManager.MakeSketchBlockFromFile(Niets, "D:\_MAIA\1_MODELES\4_BLOCS-BUFFERS\Tol ISO2768 - EN22768 - mK.SLDBLK", False, 1, 0)
Deel.EditSheet
Deel.EditSketch
Deel.ClearSelection2 Waar
Einde Sub

In jouw lijn:

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

 

Je gebruikt nog steeds Niets

Zoals ik al zei, moeten we dit vervangen door een invoegpunt!

En in jouw lijn:

SketchPoints = MathP.ArrayData

Je hebt de coördinaten niet ingevuld.

 

Ken je vba programmeren?

1 like

Er is misschien een meer sprekend voorbeeld om u hier te helpen:

'NIEUWE BLOKKEN: Blokdefinitie maken

    Stel swSketchBlockDef in = swSketchMgr.MakeSketchBlockFromSelected(Niets)

    "

    ' Definieer een invoegpunt

    nPt(0) = 60# / 1000#

    nPt(1) = -60# / 1000#

    nPt(2) = 0#

    vPt = nPt

    Stel swMathPoint in = swMathUtil.CreatePoint(vPt)

    "

    ' Voeg een instantie van de blokdefinitie in

    Stel swBlockInst in = 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 like

Als laatste heb ik de ankerpunten van de blokken veranderd.

Merici  PL

1 like

Hallo Bec2

Hoe hebben jullie de verankering van deze systemen veranderd?

Want ik weet niet zo veel van VBA en ik heb voorlopig gesleuteld om mijn blok te krijgen, maar het zet zichzelf niet op de juiste plek.

Hallo en welkom @sebastien_higaxo5742 .

Hier is een Vba-macro om een blok in te voegen door de coördinatenpunten te kiezen:

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

Dan een paar opmerkingen voor uw volgende verzoeken:

Vermijd het opgraven van 2016 Resolute-banen in de toekomst... vooral als een van de bijdragers niet recent heeft gepubliceerd.

image

1 like