Отправлено: 28.09.07 12:24. Заголовок: Определение всех пересечений деталей в сборке

Представляю вашему вниманию макрос по определению всех возможных пересечений деталей в сборке. Основан на примере из API. тестировался на AIP 11 SP3.

Public Sub FindAllInterferences()
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oResults As InterferenceResults
Dim oCheckSet As ObjectCollection
Set oCheckSet = ThisApplication.TransientObjects.CreateObjectCollection

' Add all occurrences to the object collection
Dim oOcc As ComponentOccurrence
For Each oOcc In oDoc.ComponentDefinition.Occurrences
oCheckSet.Add oOcc
Next

' Get the interference between everything.
Set oResults = oDoc.ComponentDefinition.AnalyzeInterference(oCheckSet)

If oResults.Count = 1 Then
MsgBox "There is 1 interference."
ElseIf oResults.Count > 1 Then
MsgBox "There are " & oResults.Count & " interferences."
End If

If oResults.Count > 0 Then
Dim oHS1 As HighlightSet
Set oHS1 = oDoc.HighlightSets.Add
oHS1.SetColor 255, 0, 0
Dim oHS2 As HighlightSet
Set oHS2 = oDoc.HighlightSets.Add
oHS2.SetColor 0, 255, 0

For i = 1 To oResults.Count
oHS1.Clear
oHS2.Clear
oHS1.AddItem oResults.Item(i).OccurrenceOne
oHS2.AddItem oResults.Item(i).OccurrenceTwo
MsgBox "The interference volume between " & oResults.Item(i).OccurrenceOne.Name & " and " & oResults.Item(i).OccurrenceTwo.Name & " is " & oResults.Item(i).Volume & " cm3"
Next

oHS1.Clear
oHS2.Clear
Else
MsgBox "There is no interference."
End If
End Sub

 Отправлено: 01.10.07 08:45. Заголовок: Re:

Я не программист, поэтому вопрос задам так: как этот макрос запустить?

 Отправлено: 01.10.07 10:09. Заголовок: Re:

Меню Средства (Tools) - Макросы (Macros) - Макросы (Macros...) - пишем новое имя макроса (например, FindAllInterferences) - нажимаем кнопку Create - запускается Microsoft Visual Basic - в нем уже будет добавлен текст:
Public Sub FindAllInterferences()
...

End Sub

Копируем текст макроса из сообщения (то, что между строкой названия и end sub) и вставляем в Microsoft Visual Basic между названием функции и end sub.

Теперь на экране списка макросов (Средства (Tools) - Макросы (Macros) - Макросы (Macros...)) можно выбрать FindAllInterferences и нажать Run (первая кнопка).

 Отправлено: 01.10.07 11:56. Заголовок: Re:

Совсем уж хорошо о запуске макросов сказано тут:
http://inventor.mechmagic.com/kazakov/MyArticles/ParticularityVBA_InInventor/ParticularityVBA_InInventor.htm

 Отправлено: 02.10.07 13:09. Заголовок: Re:

спасибо.

 Отправлено: 03.10.07 13:46. Заголовок: Re:

В SW это вообще встроенная фишка и наглядно паказывает, а вот Доска мудрит...

 Отправлено: 03.10.07 15:20. Заголовок: Re:

Вот именно мудрит. Откуда мне знать какие компоненты сборки проверять на пересечения, если я эти пересечения собственно и хочу найти. В конце концов я обязан знать обо всех пересечениях.

 Отправлено: 03.10.07 17:45. Заголовок: Re:

Все пересечения сразу можно найти тем же путем (встроенной в AI командой), правдо лишние "пересечения" типа Винт в резьбе отверстия придется "фильтровать" отдельно.

 Отправлено: 04.10.07 07:24. Заголовок: Re:

Витек
Спору нет, но макрос делает то же самое на пару кликов мыши быстрее.

 Отправлено: 04.10.07 08:01. Заголовок: Re:

Витек пишет:

цитата:

правдо лишние "пересечения" типа Винт в резьбе отверстия придется "фильтровать" отдельно.

Это как? Только программно?

 Отправлено: 05.10.07 05:40. Заголовок: Re:

sloter пишет:

цитата:

Это как? Только программно?

Этого я не знаю.Имелось ввиду что такие пересечения визуально можно отмести в общем пересечении.
Наверно и програмно можно.

 Отправлено: 05.10.07 06:48. Заголовок: Re:

Попробую решить это программно.