ADN Club > Inventor API
Засыпает VBA-код при работе
Vyacheslav:
Доброго времени суток.
VBA-код при работе "как бы засыпает", останавливается и просто не движется дальше. После движения или щелчка мышкой а окне Инвентора все движется дальше. При пошаговом прохождении, все проходит "на ура". Происходит это при работе с чертежом(замена зависимости, подгонка масштаба, простановка размеров, сохранение).
Как это побороть или хотябы понять: Как и почему?
Заранее спасибо.
mikazakov:
Судя по описанию, окно инвентора теряет фокус.
А на какой конкретно функции это происходит?
Vyacheslav:
Конкретно операцию я не могу определить. В это время открыт чертеж детали. Операции я описал выше. Попробовали делать тоже самое не открывая чертежа на экране, тоже самое... и в то же самое время...
filat:
А если попробовать, в начале макроса, отключить обновление экрана, а в конце включить?
Так, без кода сложно что-то комментировать...
Судя по всему код - длинный. Попробуйте его разбить на отдельные сабы ( один заканчивается - запускает следующий, ...), а в каждом сабе прописать Debug.Print - маркер-идетнификатор - хотя бы поймете на каком этапе происходит сбой...
Vyacheslav:
Вот код фукции которую он в это время выполняет:
--- Код - Visual Basic [Выбрать] ---Private Sub AddDimensionsPurlins(zielOrdner As String, dateiPrefix As String, purlinFileList As Collection, purlinIdwFileList As Collection, isZeta As Boolean, isZetaII As Boolean, isLC As Boolean, isLT As Boolean, purlinName As String, isGen2WithSpringPlate As Boolean, moduleClampAdapter As Long, sparrensystem As Long, mitPfettenklaue As Boolean) Dim idwFileOrg As String Dim idwFile As String Dim idwFilePrev As String Dim purlinFileNameStartIdx As Long Dim purlinFileNameShort As String Dim doc As DrawingDocument Dim s As Sheet If isZetaII Or isLC Or isLT Then idwFileOrg = zielOrdner + "\" + dateiPrefix + "_PFETTEN - LC-LT-Z II.idw" Else idwFileOrg = zielOrdner + "\" + dateiPrefix + "_PFETTE_Zeta.idw" End If ThisApplication.SilentOperation = True For i = 1 To purlinFileList.count purlinFileNameStartIdx = InStr(1, purlinFileList(i), "_PFETTE") purlinFileNameShort = GetFileNameWithoutExt(Mid(purlinFileList(i), purlinFileNameStartIdx)) idwFile = zielOrdner + "\" + dateiPrefix + purlinFileNameShort + ".idw" purlinIdwFileList.Add idwFile If i = 1 Then Name idwFileOrg As idwFile Else FileCopy idwFilePrev, idwFile End If idwFilePrev = idwFile Next i For i = 1 To purlinFileList.count purlinFileNameStartIdx = InStr(1, purlinFileList(i), "_PFETTE") purlinFileNameShort = GetFileNameWithoutExt(Mid(purlinFileList(i), purlinFileNameStartIdx)) idwFile = zielOrdner + "\" + dateiPrefix + purlinFileNameShort + ".idw" Set doc = ThisApplication.Documents.Open(idwFile, False) Set s = doc.Sheets(1) UpdateReferenceDoc doc, "_PFETTE", purlinFileList(i) doc.Update Dim cidx1 As Long Dim cidx2 As Long Dim cidx3 As Long Dim sPurlinLen As String cidx1 = LastIndexOf(purlinFileList(i), "_") + 1 cidx2 = LastIndexOf(purlinFileList(i), ".") cidx3 = LastIndexOf(purlinFileList(i), "(") If cidx2 > cidx3 And cidx3 > 0 Then sPurlinLen = Mid(purlinFileList(i), cidx1, cidx3 - cidx1) Else sPurlinLen = Mid(purlinFileList(i), cidx1, cidx2 - cidx1) End If AddDimensionsPurlin s, purlinFileList(i), CLng(sPurlinLen), isGen2WithSpringPlate, moduleClampAdapter, sparrensystem, mitPfettenklaue doc.Save doc.Close Next i If isZetaII Or isLC Or isLT Then Kill zielOrdner + "\" + dateiPrefix + "_PFETTE_Zeta.idw" Else Kill zielOrdner + "\" + dateiPrefix + "_PFETTEN - LC-LT-Z II.idw" End If ThisApplication.SilentOperation = False End Sub
и подфукция для простановки размеров:
--- Код - Visual Basic [Выбрать] ---Private Sub AddDimensionsPurlin(s As Sheet, purlinFile As String, pf_laenge As Long, isGen2WithSpringPlate As Boolean, moduleClampAdapter As Long, sparrensystem As Long, mitPfettenklaue As Boolean) s.Activate Dim va As DrawingView Dim vb As DrawingView Dim vy As DrawingView Set vb = GetDrawingViewS(s, "B") Set va = GetDrawingViewS(s, "A") Set vy = GetDrawingViewS(s, "Y") If moduleClampAdapter > 0 Or (sparrensystem And mitPfettenklaue) Then vy.Delete End If Dim refDocA As PartDocument Set refDocA = GetViewDocS(s, "A") Dim refDocB As PartDocument Set refDocB = GetViewDocS(s, "B") Dim wpIdx As Integer Dim yPos As Double Dim wpPointsA As WorkPoints Set wpPointsA = refDocA.ComponentDefinition.WorkPoints Dim giPointsA() As GeometryIntent Dim wpPointColA As New Collection Dim dlIdx As Long Dim ods As OrdinateDimensionSet Dim od As OrdinateDimension Dim ld As LinearGeneralDimension For i = 1 To wpPointsA.count If wpPointsA(i).Point.Y >= 0 Then va.SetIncludeStatus wpPointsA(i), True wpPointColA.Add wpPointsA(i) End If Next i InitSheetSettingsS s, 2, 4, 1, 1, 1 CenterViewOnSheetHS s, "1" AdjustViewScaleS s, "1", GetSheetContentWidthPaddingS(s), GetSheetContentHeightPaddingS(s), 5 vb.Label.Position = ThisApplication.TransientGeometry.CreatePoint2d(vb.Label.Position.X, vb.Position.Y + 2.8) va.Label.Position = ThisApplication.TransientGeometry.CreatePoint2d(va.Label.Position.X, va.Position.Y + 2.8) giPointsA = GetSortetGiList(s, wpPointColA) yPos = -0.3 For wpIdx = 1 To UBound(giPointsA) If wpIdx > 1 Then Set ld = AddDimensionLineGi(s, giPointsA(wpIdx - 1), giPointsA(wpIdx), 1.2, False) If wpIdx = UBound(giPointsA) Then ld.Tolerance.SetToSymmetric 3 / 10 Else ld.Tolerance.SetToSymmetric 1 / 10 End If End If Next Set ods = AddOrdinateDimensionLineSetGi(s, giPointsA, -0.3, False) For dlIdx = 1 To ods.Members.count Set od = ods.Members(dlIdx) If dlIdx = ods.Members.count Then od.Tolerance.SetToSymmetric Ceiling(pf_laenge / 1000) / 2 / 10 ElseIf dlIdx > 1 And dlIdx < ods.Members.count Then od.Tolerance.SetToReference End If Next dlIdx '-- Dim wpPointsB As WorkPoints Set wpPointsB = refDocB.ComponentDefinition.WorkPoints Dim giPointsB() As GeometryIntent Dim wpPointColB As New Collection For i = 1 To wpPointsB.count If wpPointsB(i).Point.Y <= 0 Then vb.SetIncludeStatus wpPointsB(i), True wpPointColB.Add wpPointsB(i) End If Next i giPointsB = GetSortetGiList(s, wpPointColB) yPos = -0.3 For wpIdx = 1 To UBound(giPointsB) If wpIdx > 1 Then Set ld = AddDimensionLineGi(s, giPointsB(wpIdx - 1), giPointsB(wpIdx), 1.3, False) If wpIdx = UBound(giPointsB) Then ld.Tolerance.SetToSymmetric 3 / 10 Else ld.Tolerance.SetToSymmetric 1 / 10 End If End If Next Set ods = AddOrdinateDimensionLineSetGi(s, giPointsB, -0.3, False) For dlIdx = 1 To ods.Members.count Set od = ods.Members(dlIdx) If dlIdx = ods.Members.count Then od.Tolerance.SetToSymmetric Ceiling(pf_laenge / 1000) / 2 / 10 ElseIf dlIdx > 1 And dlIdx < ods.Members.count Then od.Tolerance.SetToReference End If Next dlIdx '-- End Sub
Навигация
Перейти к полной версии