Robot Structural Analysis Forum
Welcome to Autodesk’s Robot Structural Analysis Forums. Share your knowledge, ask questions, and explore popular Robot Structural Analysis topics.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

VBA Maillage et Axe local Plaque

8 REPLIES 8
SOLVED
Reply
Message 1 of 9
mateaus
1027 Views, 8 Replies

VBA Maillage et Axe local Plaque

Bonjour j'aimerais faire fonctionner cette macro mais j'ai un probleme d'objet à cette ligne.

 

 Set monobjet = robapp.Project.Structure.Objects.Create(1)

Je voudrais également modifier le maillage comme sur la vidéo mais avec une macro qui définie la taille du maillage et l'orientation de l'axe local du panneau.

 

See attachment.

 

 

 

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Type pointM
    X As Double
    Y As Double
    Z As Double
End Type

'tableau pour définir les contour des panneaux

Public tableau_point_int(1 To 4) As pointM
Public tableau_point_v1(1 To 4) As pointM
Public tableau_point_v2(1 To 4) As pointM
Public tableau_point_ext(1 To 6) As pointM

Sub robot_voute()

' ouverture de robot, la session s'appellera robapp
Set robapp = New RobotApplication

' ce sera une structure de type panneaux
robapp.Project.New (I_PT_SHELL)
    
robapp.Visible = True
robapp.Interactive = True
robapp.UserControl = True

Dim RetVal

Sleep 1000

Sheets("Données.dat").Select

    A = Range("B8").Value

' robapp.Project.OpenExtFile A, I_EFF_STR, 1  ' Ouvre le fichier text se trouvant dans A

Call Plaque_Robot
 
' robapp.Quit I_QO_DISCARD_CHANGES  ' Quitter sans sauvegarde

' MsgBox "Calcul terminé"


'robapp.Project.Close

'robapp.Quit = True


End Sub

Sub serie_robot_voute()

    i = Range("E25").Value
    j = Range("H25").Value
       
    For K = i To j
       Range("E24").Select
       ActiveCell.FormulaR1C1 = K
       Call robot_voute

    
    Next
    
End Sub

Sub Plaque_Robot()

' stockage des points des contours des panneaux

    tableau_point_int(1).X = 0#
    tableau_point_int(1).Y = 0#
    tableau_point_int(1).Z = 0#

    tableau_point_int(2).X = 10
    tableau_point_int(2).Y = 0#
    tableau_point_int(2).Z = 0#

    tableau_point_int(3).X = 10
    tableau_point_int(3).Y = 10
    tableau_point_int(3).Z = 0#

    tableau_point_int(4).X = 0#
    tableau_point_int(4).Y = 10
    tableau_point_int(4).Z = 0#

 ' ***** elements Robot *****
    Dim monobjet As RobotObjObject
    Dim moncontour As New RobotGeoContour
    Dim monsegment() As New RobotGeoSegmentLine

 ' **************************
    
    Dim i As Long
    
   'contour carré donc 4 segments
      ' définition des segments
      ReDim monsegment(1 To 4)
        For i = 1 To 4

        monsegment(i).P1.Set tableau_point_int(i).X, tableau_point_int(i).Y, tableau_point_int(i).Z
        ' initialisation des contours
        moncontour.Add monsegment(i)
        Next
        
        
        moncontour.Initialize
        
        'création de l'objet panneau
        Set monobjet = robapp.Project.Structure.Objects.Create(1)
' erreur çà ne marche pas  

      monobjet.Main.Geometry = moncontour
        monobjet.Main.Attribs.Meshed = True    ' Demande si le maillage doit être généré sur l'élément objet
        monobjet.Initialize                    ' The function initializes internal data on the basis of the data defining the object. .
        monobjet.Update                        ' mise à jour de l'objet

' maillage

' à compléter

   ' définition du matériau
        Material_Name = "BETON" ' & Str(fc28)
        Set mat = robapp.Project.Structure.Labels.Create(I_LT_BAR_MATERIAL, Material_Name)
        Dim matdata As RobotMaterialData
        Set matdata = mat.Data
        matdata.Type = I_MT_CONCRETE
        matdata.E = 11000 * 30 ^ (1 / 3) * 1000000          '         matdata.E = 11000 * fc28 ^ (1 / 3) * 1000000
        matdata.NU = 0
        matdata.RO = 24530
        matdata.Kirchoff = matdata.E / (2 * (1 + matdata.NU))
        matdata.LX = 0.00001
        matdata.RE = 30 * 1000000                           '         matdata.RE = fc28 * 1000000
        robapp.Project.Structure.Labels.Store mat  ' Function saves the cut under the specified name sauvegarde des paramètre sur le nom spécifique
        
   
    ' definition de l'épaisseur

    thick_name = "EP 30"
    Dim Label As RobotLabel
    Set Label = robapp.Project.Structure.Labels.Create(I_LT_PANEL_THICKNESS, thick_name)
    Dim ThickData As RobotThicknessData
    Set ThickData = Label.Data
    ThickData.ElasticFoundation = 0        ' appui elastique : ThickData.ElasticFoundation = coefficient_raideur * 9.81 * 1000
    ThickData.ThicknessType = I_TT_HOMOGENEOUS
    ThickData.MaterialName = Material_Name
    Dim HomoThickData As RobotThicknessHomoData
    Set HomoThickData = ThickData.Data
    HomoThickData.Type = I_THT_CONSTANT
    HomoThickData.ThickConst = 30 / 100
    robapp.Project.Structure.Labels.Store Label
    monobjet.SetLabel I_LT_PANEL_THICKNESS, thick_name
    Set Label = Nothing

    moncontour.Clear
    
    Set monobjet = Nothing
    Set moncontour = Nothing
    ReDim monsegment(1 To 1)
    Set monsegment(1) = Nothing
    
End Sub

 

 

8 REPLIES 8
Message 2 of 9
Rafal.Gaweda
in reply to: mateaus


@mateaus wrote:

Bonjour j'aimerais faire fonctionner cette macro mais j'ai un probleme d'objet à cette ligne.

 

 Set monobjet = robapp.Project.Structure.Objects.Create(1)

Je voudrais également modifier le maillage comme sur la vidéo mais avec une macro qui définie la taille du maillage et l'orientation de l'axe local du panneau.

 

See attachment.

 

 

 

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Type pointM
    X As Double
    Y As Double
    Z As Double
End Type

'tableau pour définir les contour des panneaux

Public tableau_point_int(1 To 4) As pointM
Public tableau_point_v1(1 To 4) As pointM
Public tableau_point_v2(1 To 4) As pointM
Public tableau_point_ext(1 To 6) As pointM

Public robapp As RobotApplication

 

 You need this declaration as shown above



Rafal Gaweda
Message 3 of 9
mateaus
in reply to: Rafal.Gaweda

Thank you for your help. Can you answer to my question for mesh and local axes of a slab in VBA ?

Message 4 of 9
Rafal.Gaweda
in reply to: mateaus


@mateaus wrote:

Thank you for your help. Can you answer to my question for mesh and local axes of a slab in VBA ?


I have forgotten because I do not understand french



Rafal Gaweda
Message 5 of 9
mateaus
in reply to: Rafal.Gaweda

I would like to make in VBA what you see in the movie I've send.

Message 6 of 9
Rafal.Gaweda
in reply to: Rafal.Gaweda

Set monobjet = robapp.Project.Structure.Objects.Create(1)
monobjet.Main.Geometry = moncontour
monobjet.Main.Attribs.Meshed = True
monobjet.Main.Attribs.DirZ = 0     '/ or 1 to change local z
monobjet.Main.Attribs.SetDirX I_OLXDDT_CARTESIAN, 0, 1, 0    ' change of local X



Rafal Gaweda
Message 7 of 9
Rafal.Gaweda
in reply to: Rafal.Gaweda

Code for your movie

 

......

Set monobjet = robapp.Project.Structure.Objects.Create(1)
monobjet.Main.Geometry = moncontour
monobjet.Main.Attribs.Meshed = True
monobjet.Main.Attribs.DirZ = 0
monobjet.Main.Attribs.SetDirX I_OLXDDT_CARTESIAN, 1, 0, 0


monobjet.Initialize
monobjet.Update

monobjet.Mesh.Params.MeshType = I_MT_USER
monobjet.Mesh.Params.SurfaceParams.Method.Method = I_MMT_COONS
monobjet.Mesh.Params.SurfaceParams.Generation.Type = I_MGT_ELEMENT_SIZE
monobjet.Mesh.Params.SurfaceParams.Generation.ElementSize = 1

monobjet.Mesh.Generate



Rafal Gaweda
Message 8 of 9
mateaus
in reply to: Rafal.Gaweda

Hi,

 

I just want to put a linear support on a slab but not on the border of the slab with vba. Is that possible ?

 

appuis plaque.PNG

 

For the moment my macro is :

 

Public Sub appuis_robot()

 Dim monobjet As RobotObjObject
   Dim moncote As RobotObjEdge
   Dim sup As IRobotLabel
   Dim sup_data As IRobotNodeSupportData
   Dim a As Integer
      
   Set sup = Robapp.Project.Structure.Labels.Create(I_LT_SUPPORT, "appuis_entretoises")
   Set sup_data = sup.Data
 
 ' definition des appuis (rotules)
 
    sup_data.SetFixed I_NSFD_UX, True
    sup_data.SetFixed I_NSFD_UY, True
    sup_data.SetFixed I_NSFD_UZ, True
    sup_data.SetFixed I_NSFD_RX, False
    sup_data.SetFixed I_NSFD_RY, False
    sup_data.SetFixed I_NSFD_RZ, False

   Robapp.Project.Structure.Labels.Store sup

i = 15
Do Until Sheets("géométrie").Cells(i, 37).Value = "" ' or whevever you want to start

a = Sheets("géométrie").Cells(i, 37).Value

    Set monobjet = Robapp.Project.Structure.Objects.Get(a)
    Set moncote = monobjet.Main.Edges.Get(1)
    moncote.SetLabel I_LT_SUPPORT, "appuis_entretoises"
    monobjet.Update
     
    Set monobjet = Robapp.Project.Structure.Objects.Get(a)
    Set moncote = monobjet.Main.Edges.Get(3)
    moncote.SetLabel I_LT_SUPPORT, "appuis_entretoises"
    monobjet.Update
    
    i = i + 1
    
Loop

   Robapp.Project.Structure.Labels.Store sup
    Set sup_data = Nothing
    Set sup = Nothing
    Set monobjet = Nothing
    Set moncote = Nothing

End Sub

 

can you modify it to be able to do this ?

Message 9 of 9
Rafal.Gaweda
in reply to: mateaus

You have to create line \ polyline then apply support to it:

Example code:

 

Private Sub LS()

Set RobApp = New RobotApplication

 Dim monobjet As RobotObjObject
   Dim moncote As RobotObjEdge
   Dim sup As IRobotLabel
   Dim sup_data As IRobotNodeSupportData
      
   Set sup = RobApp.Project.Structure.Labels.Create(I_LT_SUPPORT, "appuis_entretoises")
   Set sup_data = sup.Data
 
 ' definition des appuis (rotules)
 
    sup_data.SetFixed I_NSFD_UX, True
    sup_data.SetFixed I_NSFD_UY, True
    sup_data.SetFixed I_NSFD_UZ, True
    sup_data.SetFixed I_NSFD_RX, False
    sup_data.SetFixed I_NSFD_RY, False
    sup_data.SetFixed I_NSFD_RZ, False

   RobApp.Project.Structure.Labels.Store sup

  
    Dim RPA As RobotPointsArray
    Set RPA = New RobotPointsArray
    RPA.SetSize 2        ' 2 points polyline = line
    RPA.Set 1, 1, 0, 0   'coordinates of 1st point of line
    RPA.Set 2, 10, 0, 0  'coordinates of 2nd point of line
    
    Dim Ln As Long
    
    Ln = RobApp.Project.Structure.Objects.FreeNumber
    RobApp.Project.Structure.Objects.CreatePolyline Ln, RPA
    
    Set monobjet = RobApp.Project.Structure.Objects.Get(Ln)
    Set moncote = monobjet.Main.Edges.Get(1)
    moncote.SetLabel I_LT_SUPPORT, "appuis_entretoises"
    monobjet.Update
    
    Set sup_data = Nothing
    Set sup = Nothing
    Set monobjet = Nothing
    Set moncote = Nothing

End Sub

 



Rafal Gaweda

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report