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
Solved! Go to Solution.
Solved by Rafal.Gaweda. Go to Solution.
Solved by Rafal.Gaweda. Go to Solution.
@Anonymous 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
Thank you for your help. Can you answer to my question for mesh and local axes of a slab in VBA ?
@Anonymous 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
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
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
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 ?
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 ?
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
Can't find what you're looking for? Ask the community or share your knowledge.