Отговори на тема  [ 12 мнения ] 
Autodesk Inventor VBA - има ли разбирачи 
Автор Съобщение
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Autodesk Inventor VBA - има ли разбирачи
Няма нищо общо с електрониката , с Бейсик или програмирането.
Два дена се боря с грешка "Тоя обект няма тоя метод" или пък извикванеето на метода крашва подфункция, та чак през една ... Обектите са ... с много потенциални родители и вероятно не избирам коректния родителски обект....Обаче йерархията е много тежка и аз трудно я смилам, пък англофорумът ми е също тъй трудно смилаем....Та ако има някой разбирач, моля, да се обади.
Боря се неща около ClientGraphics.


Вто Юли 23, 2019 5:20 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог
Аватар

Регистриран на: Съб Сеп 25, 2004 11:32 am
Мнения: 7878
Местоположение: София
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Е бъди по-конкретен, де.


Чет Юли 25, 2019 10:07 am
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Ok, утре ще пусна по-конкретен въпрос. :D с картинка.


Чет Юли 25, 2019 7:36 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Опитвам се да оцветя повърхност на сглобено изделие.
Първо намерих пример за оцветяване повърхност на детайл:
Код:
Public Sub PartPicSetFaceColor()
    Dim partDoc As PartDocument
    Set partDoc = ThisApplication.ActiveDocument
   
    ' Check to see if the client graphics already exist and delete them if they do.
    On Error Resume Next
    Dim graphics As ClientGraphics
    Set graphics = partDoc.ComponentDefinition.ClientGraphicsCollection.Item("ColorTest")
    If Err.Number = 0 Then
        graphics.Delete
        ThisApplication.ActiveView.Update
        Exit Sub
    End If
    On Error GoTo 0
   
    Dim selectedFace As Face
    Set selectedFace = ThisApplication.CommandManager.Pick(kPartFaceFilter, "Select a face")
           
    ' They don't exist so create them.
    Set graphics = partDoc.ComponentDefinition.ClientGraphicsCollection.Add("ColorTest")
    Dim node As GraphicsNode
    Set node = graphics.AddNode(1)
   
    ' Create surface graphics using the selected face.
    Dim surfGraphics As SurfaceGraphics
    Set surfGraphics = node.AddSurfaceGraphics(selectedFace)
   
    ' Set the priority so that it will display on top of the real face.
    surfGraphics.DepthPriority = 3
   
    ' Define the color using rgb values.
    surfGraphics.Color = ThisApplication.TransientObjects.CreateColor(255, 10, 10, 1)
   
    ' Refresh the view.
    ThisApplication.ActiveView.Update
End Sub


Резултат :
Part.pdf

После се опитах да променя кода до сглобка Assembly.
Код:
Public Sub M4PicSetFaceColor()
    ''Dim oDoc As PartDocument ''PartDocument was original , variant for part
    Dim oDoc As AssemblyDocument  '' variant for assembly
   
    Set oDoc = ThisApplication.ActiveDocument
   
   
   
       Dim selectedFace As Face
    Set selectedFace = ThisApplication.CommandManager.Pick(kPartFaceFilter, "Select a face")
   
   
    ' Check to see if the client graphics already exist and delete them if they do.
    On Error Resume Next
   
   
    Dim oDataSets As GraphicsDataSets
   
    Dim graphics As ClientGraphics
     
    Dim myidstring As String
    myidstring = "ColorTest13"
     
    '' Set oDataSets = oDoc.GraphicsDataSetsCollection.Item(myidstring)
    ''   If Err.Number = 0 Then
    ''    Call oDataSets.Delete
    ''    ThisApplication.ActiveView.Update
    ''    End If
   
   
    ''variant for part
     Set graphics = oDoc.ComponentDefinition.ClientGraphicsCollection.Item(myidstring)
   
    ''variant for assembly
    ''Set graphics = oDoc.AssemblyComponentDefinition.ClientGraphicsCollection.Item(myidstring)
     
     
    If Err.Number = 0 Then
       
        Call graphics.Delete
        ThisApplication.ActiveView.Update
    End If
    On Error GoTo 0
   

    ' They don't exist so create them.
   
    ''Set oDataSets = oDoc.GraphicsDataSetsCollection.Add(myidstring)
    ''variant for part
    Set graphics = oDoc.ComponentDefinition.ClientGraphicsCollection.Add(myidstring)
   
    ''variant for assembly
    ''Set graphics = oDoc.AssemblyComponentDefinition.ClientGraphicsCollection.Add(myidstring)
   
      Dim oTransientBRep As TransientBRep
        Set oTransientBRep = ThisApplication.TransientBRep
        '' Call oTransientBRep.CreateSurfaceBodyDefinition
   
    Dim node As GraphicsNode
    Set node = graphics.AddNode(1)
   
    Dim oSurfaceGraphics As SurfaceGraphics
   
    Dim oSurfaceBody As SurfaceBody
   
        Set oSurfaceBody = oTransientBRep.Copy(selectedFace)
        ''''  Set oSurfaceGraphics = node.AddSurfaceGraphics(oSurfaceBody) '''same result as below
       Set oSurfaceGraphics = node.AddSurfaceGraphics(oSurfaceBody.Faces.Item(1))
       
   
   
   
    ' Create surface graphics using the selected face.
   
    ''Set surfGraphics = node.AddSurfaceGraphics(selectedFace) ''REMFAILFAIL
      ''THIS FAILS IN VARIANT FOR ASSEMBLY!!
   
   
    ' Set the priority so that it will display on top of the real face.
    oSurfaceGraphics.DepthPriority = 3
    ' Define the color using rgb values.
    oSurfaceGraphics.Color = ThisApplication.TransientObjects.CreateColor(10, 255, 10, 1)
    ' Refresh the view.
    ThisApplication.ActiveView.Update
End Sub


Обаче не става. Спира с грешка на линията с коментар ''REMFAILFAIL.

Четох , променях и стигнах до следния код:

Код:
Dim myidstring As String
Const cmyid As String = "Colortest"


Public Sub M6PicSetFaceColor()
    ''Dim oDoc As PartDocument ''PartDocument was original , variant for part
    Dim oDoc As AssemblyDocument  '' variant for assembly
   
    Set oDoc = ThisApplication.ActiveDocument
   
   
   
       Dim selectedFace As Face
    Set selectedFace = ThisApplication.CommandManager.Pick(kPartFaceFilter, "Select a face")
   
   
    ' Check to see if the client graphics already exist and delete them if they do.
    On Error Resume Next
   
   
    Dim oDataSets As GraphicsDataSets
   
    Dim graphics As ClientGraphics
     
    ''Dim myidstring As String
    myidstring = cmyid '' "ColorTest13"
     
     

   
       Set graphics = oDoc.ComponentDefinition.ClientGraphicsCollection.Item(myidstring)
     
     
    If Err.Number = 0 Then
   
     ''   Call graphics.Delete
        ThisApplication.ActiveView.Update
        Else:
        Set graphics = oDoc.ComponentDefinition.ClientGraphicsCollection.Add(myidstring)
    End If
    ''On Error GoTo 0
   

    ' They don't exist so create them.
   
 
    ''variant for part
    Set graphics = oDoc.ComponentDefinition.ClientGraphicsCollection.Add(myidstring)
   
    ''variant for assembly
    ''Set graphics = oDoc.AssemblyComponentDefinition.ClientGraphicsCollection.Add(myidstring)
    '' run-time error Object doesnt support this property or method
   
      Dim oTransientBRep As TransientBRep
        Set oTransientBRep = ThisApplication.TransientBRep
        '' Call oTransientBRep.CreateSurfaceBodyDefinition
   
    Dim node As GraphicsNode
    Set node = graphics.AddNode(1)
   
    Dim oSurfaceGraphics As SurfaceGraphics
   
    Dim oSurfaceBody As SurfaceBody
   
        Set oSurfaceBody = oTransientBRep.Copy(selectedFace)
        ''''  Set oSurfaceGraphics = node.AddSurfaceGraphics(oSurfaceBody) '''same result as below
       Set oSurfaceGraphics = node.AddSurfaceGraphics(oSurfaceBody.Faces.Item(1))
       
   
   
   
    ' Create surface graphics using the selected face.
   
    ''Set surfGraphics = node.AddSurfaceGraphics(selectedFace)
      ''THIS FAILS IN VARIANT FOR ASSEMBLY!!
   
   
    ' Set the priority so that it will display on top of the real face.
    oSurfaceGraphics.DepthPriority = 3
    ' Define the color using rgb values.
    oSurfaceGraphics.Color = ThisApplication.TransientObjects.CreateColor(10, 255, 10, 1)
    ' Refresh the view.
    ThisApplication.ActiveView.Update
End Sub


Public Sub M6Delete_added()
      myidstring = cmyid
       Dim oDoc As AssemblyDocument  '' variant for assembly
   
    Set oDoc = ThisApplication.ActiveDocument
     
    On Error Resume Next
   
   Set graphics = oDoc.ComponentDefinition.ClientGraphicsCollection.Item(myidstring)
     
     
    If Err.Number = 0 Then
   
        Call graphics.Delete
       ThisApplication.ActiveView.Update
    End If
End Sub




Прикачени файлове:
Коментар на файл: Успешно оцветена повърхност на Part с първия код.
Part.pdf [46.53 KiB]
203 пъти
Пет Юли 26, 2019 3:32 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
С последния код на Assembly
се получава странно разположение на копията на повърхностите.


Прикачени файлове:
Коментар на файл: Резултат от третия код.
Assembly12color.pdf [69.43 KiB]
207 пъти
Пет Юли 26, 2019 3:36 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог
Аватар

Регистриран на: Съб Сеп 25, 2004 11:32 am
Мнения: 7878
Местоположение: София
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
някаква информация защо гърми няма ли?


Пет Авг 09, 2019 1:04 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Гърми ми главата.
Всъщност ...йерархията е необятна,,,,,а документацията е океан от късчета информация. Океанът е заровен в планини от работещи и неработещи линкове.
Това е мое мнение и не ангажира/оплюва/хвали никого.

В някое късче се споменава, че оцветявам "оригиналната" повърхност - по оригиналния парт/чарк.
Трябваше да измъкна отнякъде матрицата на трансформация - от библиотечния към текущия и да извикам същата трансформация за новата повърхност. Това беше отдавна ...преди 10-15 дни и вече го забравих. Напредвам с по около половин аутодесковска концепция на всеки 3 дни (между другата ми работа, в кафе паузите). Долу-горе със същата скорост ги забравям.

По едно време зададох някакъв въпрос по темата в официалния форум...даже и не ме напсуваха...

Всъщност крайната цел е следната. Имаме тръбни рамки/конструкции(платформи за кантари), проектирани на Инвентор.
Проблемът е - може ли да се изгенерира от тези файлове пътя за ЦНЦ-заваряване.
Борбата продължава.


Пет Авг 09, 2019 8:28 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Нед Сеп 26, 2004 8:21 pm
Мнения: 27949
Местоположение: София
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Доколкото много хвалят cam модула на ауто деск трябва да може, ама като говориш за път на заварка предполагам визираш манипулатор, що не пробваш със някой специализиран софт.
П. С. ти в модела имаш ли weld bead?


Съб Авг 10, 2019 7:09 am
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Weld bead добавям шев по шев, не зная друг начин. От една страна е бевно, от друга е добре - имам по-добър контрол.


Нед Авг 11, 2019 7:18 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Всъщност началната цел е почти постигната - предполагам - до 10ина дни да изкарам някакъв суров файл с координати за заваряване - имам план , както се казва. :D


Нед Авг 11, 2019 7:21 pm
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Нед Сеп 26, 2004 8:21 pm
Мнения: 27949
Местоположение: София
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
А ако имаш weld bead не можеш ли само тях да ги вземешеш и по тях да направиш пътя? Може би нещо аз не схващам, ама не вижда какво общо има с оцветяването, или ти го даде като пример?


Пон Авг 12, 2019 7:53 am
Профил
Ранг: Форумен бог
Ранг: Форумен бог

Регистриран на: Вто Фев 07, 2012 10:22 pm
Мнения: 3074
Мнение Re: Autodesk Inventor VBA - има ли разбирачи
Оцветяването го правя , за да видя ,дали нацелвам правилните обекти и техните компоненти. Хващам един weldbead , работя по него и оцветявам - за да виждам какво пресмятам. Накрая оцветявката ще покаже, докъде съм се ориентирал, какво има да се довършва - на ръка или с код.


Пон Авг 12, 2019 9:26 am
Профил
Покажи мненията от миналия:  Сортирай по  
Отговори на тема   [ 12 мнения ] 

Кой е на линия

Потребители разглеждащи този форум: 0 регистрирани и 5 госта


Вие не можете да пускате нови теми
Вие не можете да отговаряте на теми
Вие не можете да променяте собственото си мнение
Вие не можете да изтривате собствените си мнения
Вие не можете да прикачвате файл

Търсене:
Иди на:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group.
Designed by ST Software for PTF.
Хостинг и Домейни