Я хочу изменить уже работающий макрос, который перечисляет номер детали и имя защиты в списке. Теперь я также пытаюсь указать длину каждой защиты, которую я могу найти в моем кабеле. Я просмотрел его, и люди сказали мне, что вы не можете получить доступ к электрическим свойствам защиты, где я могу определить длину, поэтому мне нужно найти обходной путь. Сначала мне нужно создать параметр для каждой защиты. Затем создайте формулу (длина кривой и 2 точки) для ввода параметра. Затем укажите значение в списке.
selection1.Search "CATElectricalSearch.Protection,all"
Dim i As Integer
Dim oInstProd As Product
Dim strpartno As String
For i = 1 To selection1.Count
Set oInstProd = selection1.Item(i).LeafProduct
strpartno = oInstProd.ReferenceProduct.PartNumber
'test
selection1.Item(1).Document.Activate
Dim part1 As Part
Set part1 = selection1.Item(1).Document.Part
Dim parameters1 As Parameters
Set parameters1 = part1.Parameters
On Error Resume Next
Err.Clear 'Clear any previous error messages
Set ParamV = parameters1.Item("Lungime")
If Err.Number = 0 Then
parameters1.Remove "Lungime"
Else
'TODO Stuff if parameter does not Exist
'create a new length type parameter, set its value to 0 for now
Dim length1 As Dimension
Set length1 = parameters1.CreateDimension("", "LENGTH", 0)
'if you want to rename the parameter
length1.Rename "Lungime"
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("External References")
Set hybridShapes1 = hybridBody1.HybridShapes
Dim reference1 As Reference
Set reference1 = hybridShapes1.Item(1) 'get curve
Dim reference2 As Reference
Set reference2 = hybridShapes1.Item(2) 'get first point
Dim reference3 As Reference
Set reference3 = hybridShapes1.Item(3) 'get second point
'create a new formula to link to the parameter
Dim relations1 As Relations
Set relations1 = part1.Relations
'make sure points are labeled MyEndPt1 and MyEndPt2 respectively
Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formula.47", "", length1, "length( `External References\" & reference1.Name & "` ,`External References\" & reference2.Name & "` , `External References\" & reference3.Name & "` ) ")
'MsgBox length1.ValueAsString
End If
'end test
With UserFormTapeCheck.ListBox1
.AddItem
.List(i - 1, 0) = selection1.Item(i).LeafProduct.Name
.List(i - 1, 1) = strpartno
'test
.List(i - 1, 2) = length1.ValueAsString
'end test
End With
'test
relations1.Remove "Formula.47"
parameters1.Remove "Lungime"
'end test
Next
selection1.Clear
Макрос работает идеально, если я указываю только номер детали и leafproduct.name
. Мне нужно попасть внутрь детали. Думаю, я все еще нахожусь внутри продукта, поэтому макрос не может получить ни параметры, ни гибридные тела.