Habs selbst hinbekommen, hat nur insgesamt 8 Stunden gedauert
Fuer alle dies interessiert:
Function blockausblenden(ByVal Blockname As String, ByVal aktion As String)
On Error Resume Next
'In der Vorlage sind die Linien zu Blöcken zusammengefasst.
'Das ermöglicht, daß die Linien über definierte Bezeichnungen zugänglich sind
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swBlockDef As SldWorks.SketchBlockDefinition
Dim swFeat As SldWorks.Feature
Dim swBlinst As SldWorks.SketchBlockInstance
Dim swSketchMan As SldWorks.SketchManager
Dim swSketchSeg As SldWorks.SketchSegment
Dim vblocks As Variant
Set swApp = CreateObject("sldworks.application")
Set swModel = swApp.ActiveDoc
Set swDraw = swApp.ActiveDoc
swDraw.ClearSelection2 (True)
swDraw.EditTemplate
swDraw.EditSketch
Blockname = "Block" & Blockname
Set sketchman = swDraw.SketchManager
vblocks = sketchman.GetSketchBlockDefinitions
For ii = 0 To UBound(vblocks)
Set swBlockDef = vblocks(ii)
vblockinst = swBlockDef.GetInstances
Namegelesen = vblockinst(0).Name
If Namegelesen Like Blockname & "*" Then
For i = 0 To UBound(vblockinst)
Set swBlinst = vblockinst(i)
If aktion Like "UNBLN" Then
swBlinst.Scale2 = 1
Else
swBlinst.Scale2 = 0.0001
End If
Next
End If
Next
End Function
[Diese Nachricht wurde von dwieching am 31. Mai. 2007 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP