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 ;-)
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:
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
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.