Hi everyone. I have a rule to derive blocks of parts, but I can only select one each time I run the rule.
Imports System.IO
Class Prop
Public Filename As String = ""
Public Pathfile As String = ""
Public Blockname As String = ""
End Class
Sub Main
If ThisDoc.Document.SubType <> "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then
MessageBox.Show("No es una Pieza", "Title")
Return
End If
Dim PathFolder As String = ThisApplication.FileLocations.Workspace & "\1. PREPS"
If Not Directory.Exists(PathFolder) Then
MessageBox.Show("La carpeta especificada no existe: " & Constants.vbCrLf & PathFolder, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Dim Listname As New ArrayList, ListFiles As List(Of Prop), oProp As Prop
ListFiles = GetListPreps(PathFolder, Listname)
If ListFiles.Count = 0 Then
MessageBox.Show("Sin archivos en ruta", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Dim NombrePieza As String = GetDataInput(Listname, "Listado de archivos en la carpeta:", "Seleccione un archivo", "PREPS")
If NombrePieza = "" Then
MessageBox.Show("Sin selección de pieza", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
oProp = ListFiles.Find(Function(x) x.Filename = NombrePieza)
If oProp Is Nothing Then
MessageBox.Show("No encontrado", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Listname = GetListBlocks(oProp)
Dim ListBlockActive As List(Of Prop) = GetListDerivedActive()
Listname = FilterArrayList(Listname, oProp, ListBlockActive)
If Listname.Count = 0 Then
MessageBox.Show("Sin bloques para agregar", "Información", MessageBoxButtons.OK, MessageBoxIcon.Information)
Exit Sub
End If
Dim NombreBloque As String = GetDataInput(Listname, "Listado de bloques:", "Seleccione un bloque", "PREPS")
If NombreBloque = "" Then
MessageBox.Show("Sin selección de bloque", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
GetListDerivedPartComponents(oProp, NombreBloque)
End Sub
Private Function FilterArrayList(Listname As ArrayList, oProp As Prop, ListFiles As List(Of Prop)) As ArrayList
Dim ListResult As New ArrayList
Dim ListFilter As List(Of Prop) = ListFiles.FindAll(Function(x) x.Filename = oProp.Filename)
If ListFilter.Count = 0 Then
Return Listname
End If
For Each str As String In Listname
If ListFilter.Exists(Function(x) x.Blockname = Str) Then
ListResult.Add(Str)
End If
Next
Return ListResult
End Function
Private Function GetListPreps(PathFolder As String, ByRef Listname As ArrayList) As List(Of Prop)
Dim oProp As Prop, ListFiles As New List(Of Prop)
Listname.Clear
' Solicitar palabra clave para filtrar archivos
Dim filtro As String
filtro = InputBox("Ingrese parte del nombre del archivo a buscar (déjelo vacío para listar todos):", "Filtrar archivos", "")
' Obtener archivos de la carpeta
Dim files As List(Of String) = Directory.GetFiles(PathFolder, "*.ipt", System.IO.SearchOption.TopDirectoryOnly).ToList
' Aplicar filtro solo si el usuario ingresó texto
If filtro <> "" Then
files = files.Where(Function(f) System.IO.Path.GetFileName(f).IndexOf(filtro, StringComparison.OrdinalIgnoreCase) >= 0).ToList()
End If
' Si no hay archivos coincidentes, mostrar mensaje y salir
If files.Count = 0 Then
MessageBox.Show("No se encontraron archivos que coincidan con el filtro.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return ListFiles
End If
' Agregar archivos a la lista
For Each File As String In files
oProp = New Prop
oProp.Filename = System.IO.Path.GetFileName(File)
oProp.Pathfile = File
Listname.Add(oProp.Filename)
ListFiles.Add(oProp)
Next
Return ListFiles
End Function
Private Function GetListBlocks(oProp As Prop) As ArrayList
Dim Listname As New ArrayList
Dim oPartDoc As PartDocument = ThisApplication.Documents.Open(oProp.Pathfile, False)
For Each partblock As SketchBlockDefinition In oPartDoc.ComponentDefinition.SketchBlockDefinitions
Listname.Add(partblock.Name)
Next
oPartDoc.Close(True)
Return Listname
End Function
Private Function GetDataInput(Listname As ArrayList, mensajeparamostrar As String, defaultvalue As String, titulo As String) As String
Dim height As Integer = 500
If Listname.Count < 5 Then height = Listname.Count * 30
Return InputListBox(mensajeparamostrar, Listname, defaultvalue, titulo,, height, 0)
End Function
Private Function GetListDerivedActive() As List(Of Prop)
Dim oPartDoc As PartDocument = ThisDoc.Document, ListFiles As New List(Of Prop), oProp As Prop, oDerivedPartDef As DerivedPartUniformScaleDef
For Each oDerPartComp As DerivedPartComponent In oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents
oDerivedPartDef = oDerPartComp.Definition
For Each oderv As DerivedPartEntity In oDerivedPartDef.SketchBlockDefinitions
If Not oderv.IncludeEntity Then
oProp = New Prop
oProp.Filename = oDerPartComp.Name
oProp.Blockname = oderv.ReferencedEntity.Name
ListFiles.Add(oProp)
End If
Next
Next
Return ListFiles
End Function
Private Sub GetListDerivedPartComponents(oProp As Prop, NombreBloque As String)
Dim oPartDoc As PartDocument = ThisDoc.Document, status As Boolean = False
Dim oDerivedPartDef As DerivedPartUniformScaleDef
For Each oDerPartComp As DerivedPartComponent In oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents
If oProp.Filename = oDerPartComp.Name Then
oDerivedPartDef = oDerPartComp.Definition
oDerivedPartDef.SketchBlockDefinitions(NombreBloque).IncludeEntity = True
oDerPartComp.Definition = oDerivedPartDef
status = True
End If
Next
If Not status Then
oDerivedPartDef = oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(oProp.Pathfile)
oDerivedPartDef.ScaleFactor = 1
oDerivedPartDef.ExcludeAll
oDerivedPartDef.UseColorOverridesFromSource = False
oDerivedPartDef.SketchBlockDefinitions.Item(NombreBloque).IncludeEntity = True
oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
End If
InventorVb.DocumentUpdate()
End Sub
The rule shows me the block´s list in this form.
Is it possible to select multiple options?
