CATVBA : Export Sketch Geometry to Excel
CATVBA : Export Sketch Geometry to Excel
(OP)
Hi there.
I am new to the forum although i already used some tips I found in it thanks to google. But today I need something I didn't found. Hope someone can help me.
What I need is to write a macro to export geometric objects of an active sketch in excel. For example something kind of like this :
Set MyPart = CATIA.ActiveDocument.Part
Set MySketch = MyPart.ActiveSketch
For Each item in MySketch
'get points and lines coordinates
next
I have difficulties to find it out by myself since I am not an advance CATVBA user.
Thanks to anyone that would try to help.
Victor
I am new to the forum although i already used some tips I found in it thanks to google. But today I need something I didn't found. Hope someone can help me.
What I need is to write a macro to export geometric objects of an active sketch in excel. For example something kind of like this :
Set MyPart = CATIA.ActiveDocument.Part
Set MySketch = MyPart.ActiveSketch
For Each item in MySketch
'get points and lines coordinates
next
I have difficulties to find it out by myself since I am not an advance CATVBA user.
Thanks to anyone that would try to help.
Victor





RE: CATVBA : Export Sketch Geometry to Excel
indocti discant et ament meminisse periti
RE: CATVBA : Export Sketch Geometry to Excel
Thanks for answering.
I want the macro runable on any sketch, this not mean to be used for a specific one. I can save one example as IGES :
Download IGES
RE: CATVBA : Export Sketch Geometry to Excel
What Eric wanted to say is that you can open the igs file with a simple text editor and see all data inside (read before a little bit about igs files structure).
I would avoid to use that file host (warnings and deletion from antivirus software), better upload files directly here with engineering.com, zip file.
If you don't want to use the igs, then you need to create a macro to get all the points in all sketches (eventually name of their parents - lines itself doesn't have coordinates).
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: CATVBA : Export Sketch Geometry to Excel
I haven't thought of using the IGES that way. I was hoping being able to program this to go further with it after. Anyway I'm going to learn a bit of IGES structure and I think this is going to work.
Thanks for your help.
Victor
RE: CATVBA : Export Sketch Geometry to Excel
I haven't thought of using the IGES that way. I was hoping being able to program this to go further with it after. Anyway I'm going to learn a bit of IGES structure and I think this is going to work.
Thanks for your help.
Victor
RE: CATVBA : Export Sketch Geometry to Excel
indocti discant et ament meminisse periti
RE: CATVBA : Export Sketch Geometry to Excel
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: CATVBA : Export Sketch Geometry to Excel
CODE -->
Sub CATMain() Path = "C:\Alex\Book1.xlsx" Set Document = CATIA.ActiveDocument Dim oPart As Part Set oPart = Document.Part Dim oBody As Body Set oBody = oPart.Bodies.Item("PartBody") Dim oSketch As Sketch Set oSketch = oBody.Sketches.Item("Sketch.1") Dim geometricElements1 As GeometricElements Set geometricElements1 = oSketch.GeometricElements Set objExcel = CreateObject("Excel.Application") Set workbook = objExcel.Workbooks.Open(Path) objExcel.Cells(1, 1).Value = "Name" objExcel.Cells(1, 2).Value = "Type" objExcel.Cells(1, 3).Value = "Start Point (X)" objExcel.Cells(1, 4).Value = "Start Point (y)" objExcel.Cells(1, 5).Value = "End Point (X)" objExcel.Cells(1, 6).Value = "End Point (y)" objExcel.Cells(1, 7).Value = "Radius" objExcel.Cells(1, 8).Value = "Construction" objExcel.Cells(1, 9).Value = "Line Type" Dim Line_test As Variant Dim Endpoint(3) Dim Point_test As Variant Dim point_coords(1) For i = 1 To geometricElements1.Count LastRow = objExcel.Range("A65536").End(xlUp).Row + 1 Dim linetype Select Case geometricElements1.Item(i).GeometricType Case 0 AA = "Unknown" objExcel.Cells(LastRow, 1).Value = AA Case 1 'Axis AA = "Axis2D" objExcel.Cells(LastRow, 1).Value = AA A = geometricElements1.Item(i).Name B = geometricElements1.Item(i).GeometricType objExcel.Cells(LastRow, 1).Value = A objExcel.Cells(LastRow, 2).Value = B Case 2 'Point A = geometricElements1.Item(i).Name B = geometricElements1.Item(i).GeometricType objExcel.Cells(LastRow, 1).Value = A objExcel.Cells(LastRow, 2).Value = B Set Point_test = geometricElements1.Item(i) Point_test.GetCoordinates point_coords joe = geometricElements1.Item(i).Construction EE = point_coords(0) / 25.4 FF = point_coords(1) / 25.4 objExcel.Cells(LastRow, 3).Value = EE objExcel.Cells(LastRow, 4).Value = FF objExcel.Cells(LastRow, 8).Value = joe Case 3 'Line Dim selection1 Set selection1 = CATIA.ActiveDocument.Selection selection1.Add geometricElements1.Item(i) A = geometricElements1.Item(i).Name B = geometricElements1.Item(i).GeometricType joe = geometricElements1.Item(i).Construction Set Line_test = geometricElements1.Item(i) Line_test.GetEndPoints Endpoint AA = Endpoint(0) / 25.4 BB = Endpoint(1) / 25.4 CC = Endpoint(2) / 25.4 DD = Endpoint(3) / 25.4 objExcel.Cells(LastRow, 1).Value = A objExcel.Cells(LastRow, 2).Value = B objExcel.Cells(LastRow, 3).Value = AA objExcel.Cells(LastRow, 4).Value = BB objExcel.Cells(LastRow, 5).Value = CC objExcel.Cells(LastRow, 6).Value = DD objExcel.Cells(LastRow, 8).Value = joe linetype = CLng(0) Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties visProperties1.GetRealLineType linetype objExcel.Cells(LastRow, 9).Value = linetype selection1.Clear Case 4 AA = "ControlPoint2D" objExcel.Cells(LastRow, 1).Value = AA Case 5 ' Radius A = geometricElements1.Item(i).Name B = geometricElements1.Item(i).GeometricType Set Line_test = geometricElements1.Item(i) Line_test.GetEndPoints Endpoint AA = Endpoint(0) / 25.4 BB = Endpoint(1) / 25.4 CC = Endpoint(2) / 25.4 DD = Endpoint(3) / 25.4 GG = Line_test.Radius / 25.4 joe = geometricElements1.Item(i).Construction objExcel.Cells(LastRow, 1).Value = A objExcel.Cells(LastRow, 2).Value = B objExcel.Cells(LastRow, 3).Value = AA objExcel.Cells(LastRow, 4).Value = BB objExcel.Cells(LastRow, 5).Value = CC objExcel.Cells(LastRow, 6).Value = DD objExcel.Cells(LastRow, 7).Value = GG objExcel.Cells(LastRow, 8).Value = joe linetype = CLng(0) Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties visProperties1.GetRealLineType linetype objExcel.Cells(LastRow, 9).Value = linetype selection1.Clear Case 6 AA = "Hyperbola" objExcel.Cells(LastRow, 1).Value = AA Case 7 AA = "Parabola" objExcel.Cells(LastRow, 1).Value = AA Case 8 AA = "Ellipse" objExcel.Cells(LastRow, 1).Value = AA Case 9 AA = "Spline" objExcel.Cells(LastRow, 1).Value = AA End Select Next i End SubSomething to start ...
RE: CATVBA : Export Sketch Geometry to Excel
Nice, good to see solution.
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: CATVBA : Export Sketch Geometry to Excel
On my side with the IGES it works great. Not very clean but I use excel as a temporary file to get lines and circles only (what I need) to export it to an ANSYS macro file.
Here is the VBA code (not clean at all but still works !!!)
CODE --> VBA
Sub IGES_Decoder() For i = 1 To 20 ActiveSheet.Columns(1).Delete Next i Range("A1").Select Dim oFSO As Scripting.FileSystemObject Dim oFl As Scripting.File Dim oTxt As Scripting.TextStream 'Instanciation du FSO Set oFSO = New Scripting.FileSystemObject Set oFl = oFSO.GetFile("C:\Users\user1\Desktop\CATSYS\Calibrage\go.igs") Set oTxt = oFl.OpenAsTextStream(ForReading) oTxt.ReadAll ligne = oTxt.Line Dim tableau() ReDim tableau(ligne, 162) Set oTxt = oFl.OpenAsTextStream(ForReading) With oTxt While Not .AtEndOfStream tableau(oTxt.Line, oTxt.Column - 1) = oTxt.Read(1) Wend End With Dim intFic As Integer intFic = FreeFile Open "C:\Users\user1\Desktop\CATSYS\Calibrage\go.txt" For Output As intFic ' ************************* ' *****lignes 110 !!!!***** ' ************************* i = 0 j = 0 Dim test As Boolean test = False While test = False i = i + 1 If tableau(i, 73) = "P" Then test = True Wend test = False While test = False If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 Then j = i test = True End If i = i + 1 Wend i = i - 1 nb110 = 0 While tableau(i, 1) <> "S" If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 And tableau(i, 4) = "," Then nb110 = nb110 + 1 i = i + 1 Else i = i + 1 End If Wend i = i - 1 'debut = j 'fin = i Dim doubleligne As Boolean doubleligne = False For cpt = j To i If tableau(cpt, 1) = 1 And tableau(cpt, 2) = 1 And tableau(cpt, 3) = 0 And tableau(cpt, 4) = "," Then For co = 1 To 81 For k = 1 To 80 If tableau(cpt, k) = "," And tableau(cpt, k + 1) = " " Then doubleligne = True doublelignenum = k Exit For End If Next If doubleligne = True Then For k = 1 To 81 tableau(cpt, doublelignenum + k) = tableau(cpt + 1, k) Next End If If tableau(cpt, co) <> ";" Then Print #intFic, tableau(cpt, co); If tableau(cpt, co) = ";" Then Exit For End If Next Print #intFic, "" End If Next nbline = nbline + i - j + 1 ' ************************* ' *****matrix 124 !!!!***** ' ************************* i = 0 j = 0 test = False While test = False i = i + 1 If tableau(i, 73) = "P" Then test = True Wend test = False While test = False If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 Then j = i test = True End If i = i + 1 Wend i = i - 1 nb124 = 0 While tableau(i, 1) <> "S" If tableau(i, 1) = 1 And tableau(i, 2) = 2 And tableau(i, 3) = 4 And tableau(i, 4) = "," Then nb124 = nb124 + 1 i = i + 1 Else i = i + 1 End If Wend i = i - 1 'debut = j 'fin = i doubleligne = False For cpt = j To i If tableau(cpt, 1) = 1 And tableau(cpt, 2) = 2 And tableau(cpt, 3) = 4 And tableau(cpt, 4) = "," Then For co = 1 To 162 For k = 1 To 80 If tableau(cpt, k) = "," And tableau(cpt, k + 1) = " " Then doubleligne = True doublelignenum = k Exit For End If Next If doubleligne = True Then For k = 1 To 81 tableau(cpt, doublelignenum + k) = tableau(cpt + 1, k) Next End If If tableau(cpt, co) <> ";" Then Print #intFic, tableau(cpt, co); If tableau(cpt, co) = ";" Then Exit For End If Next Print #intFic, "" End If Next nbline = nbline + i - j + 1 ' ************************* ' *****circle 100 !!!!***** ' ************************* i = 0 j = 0 test = False While test = False i = i + 1 If tableau(i, 73) = "P" Then test = True Wend test = False While test = False If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 Then j = i test = True End If i = i + 1 Wend i = i - 1 nb100 = 0 While tableau(i, 1) <> "S" If tableau(i, 1) = 1 And tableau(i, 2) = 0 And tableau(i, 3) = 0 And tableau(i, 4) = "," Then nb100 = nb100 + 1 i = i + 1 Else i = i + 1 End If Wend i = i - 1 'debut = j 'fin = i doubleligne = False For cpt = j To i If tableau(cpt, 1) = 1 And tableau(cpt, 2) = 0 And tableau(cpt, 3) = 0 And tableau(cpt, 4) = "," Then For co = 1 To 81 For k = 1 To 80 If tableau(cpt, k) = "," And tableau(cpt, k + 1) = " " Then doubleligne = True doublelignenum = k Exit For End If Next If doubleligne = True Then For k = 1 To 81 tableau(cpt, doublelignenum + k) = tableau(cpt + 1, k) Next End If If tableau(cpt, co) <> ";" Then Print #intFic, tableau(cpt, co); If tableau(cpt, co) = ";" Then Exit For End If Next Print #intFic, "" End If Next nbline = nbline + i - j + 1 'COPIE !! Close intFic Range("A1").Value = "type" Range("B1").Value = "x1" Range("C1").Value = "y1" Range("D1").Value = "z1" Range("E1").Value = "x2" Range("F1").Value = "y2" Range("G1").Value = "z2" With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\User1\Desktop\CATSYS\Calibrage\go.txt", Destination:=Range("$A$2")) .Name = "Part1_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With ActiveWindow.SmallScroll Down:=12 Range("A1").Select Range("H2", "O" & nb110 + 1).Value = "" 'ActiveSheet.Columns(8).Delete 'ActiveSheet.Columns(8).Delete 'ActiveSheet.Columns(8).Delete intFic = FreeFile Open "C:\Users\user1\Desktop\CATSYS\Calibrage\go.mac" For Output As intFic Print #intFic, "FINISH" Print #intFic, "/CLEAR,NOSTART" Print #intFic, "/prep7" Print #intFic, "et,1,beam188" 'Print #intFic, "KEYOPT , 1, 1, 1" 'Print #intFic, "KEYOPT , 1, 2, 0" Print #intFic, "et,2,combin14" Print #intFic, "KEYOPT , 2, 1, 0" Print #intFic, "KEYOPT , 2, 2, 6" 'Print #intFic, "KEYOPT , 2, 3, 4" Print #intFic, "type,1" Print #intFic, "MP,DENS,1,8.96e-09, ! tonne mm^-3" Print #intFic, "MP,EX,1,107000, ! tonne s^-2 mm^-1" Print #intFic, "MP,NUXY,1,0.22," Print #intFic, "MP,MURX,1,10000," j = 0 Print #intFic, "SECTYPE , 1, BEAM, RECT, , 0" Print #intFic, "SECOFFSET , CENT" Print #intFic, "SECDATA , 5, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0" Print #intFic, "SECNUM , 1" For i = 1 To nb110 Print #intFic, "n,," & Range("B" & i + 1).Value & "," & Range("C" & i + 1).Value & "," & Range("D" & i + 1).Value & "," Print #intFic, "n,," & Range("E" & i + 1).Value & "," & Range("F" & i + 1).Value & "," & Range("G" & i + 1).Value & "," j = j + 2 Print #intFic, "e," & j - 1 & "," & j Next Dim xnoeud() As String Dim ynoeud() As String Dim raid() As String ReDim xnoeud(nb124) ReDim ynoeud(nb124) ReDim raid(nb124) Print #intFic, "*dim,listnoeuds,," & nb124 & "," & 2 Print #intFic, "n , , 0, 0, 1" For i = 1 To nb124 xnoeud(i) = Range("E" & nb110 + i + 1).Value ynoeud(i) = Range("I" & nb110 + i + 1).Value raid(i) = Range("E" & i + nb124 + nb110 + 1).Value Next Print #intFic, "type,2" For i = 1 To nb124 Print #intFic, "nsel , all" Print #intFic, "noeud1=NODE(" & xnoeud(i) & "," & ynoeud(i) & ",0)" Print #intFic, "nsel,u,node,,noeud1" Print #intFic, "noeud2=NODE(" & xnoeud(i) & "," & ynoeud(i) & ",0)" Print #intFic, "nsel,all" Print #intFic, "R," & i & "," & raid(i) & "*2000,0,0,0,0,0,0," Print #intFic, "RMORE,0," Print #intFic, "REAL," & i Print #intFic, "e,noeud1,noeud2," & nb110 + 1 Print #intFic, "cerig,noeud1,noeud2,UXYZ" Print #intFic, "listnoeuds(" & i & ",1)=noeud1" Print #intFic, "listnoeuds(" & i & ",2)=noeud2" Next Print #intFic, "nsel , all" For i = 1 To nb124 Print #intFic, "nsel , u, Node, , listnoeuds(" & i & ", 1)" Print #intFic, "nsel , u, Node, , listnoeuds(" & i & ", 2)" Next Print #intFic, "numm,node,.01" Print #intFic, "nsel,all" Print #intFic, "esel,all" Print #intFic, " *ask, Noeudchar, ""Charger quel noeud ?"", 1 " Print #intFic, " *ask, forceY, ""Quelle force en Y ?"", 0 " Print #intFic, " *ask, forceX, ""Quelle force en X ?"", 0 " Print #intFic, " *ask, NbNoeudblo, ""Bloquer Combien de noeud(s) ?"", 1 " Print #intFic, "*dim,Noeudblo,, NbNoeudblo" Print #intFic, "*do,i,1,NbNoeudblo" Print #intFic, " *ask, Noeudblo(i), ""Bloquer quel noeud ?"", 1 " Print #intFic, "D,Noeudblo(i),all,0" Print #intFic, "*enddo" Print #intFic, "F,Noeudchar,FY,forceY" Print #intFic, "F,Noeudchar,FX,forceX" 'Print #intFic, "F,48,FY,100" 'Print #intFic, "F,48,FX,10" 'Print #intFic, "D,14,all,0" 'Print #intFic, "D,30,all,0" 'Print #intFic, "D,58,all,0" Print #intFic, "/eof" Print #intFic, "/sol" Print #intFic, "solve" Print #intFic, "/POST1" Print #intFic, "INRES , ALL" Print #intFic, "FILE,'Calibrage','rst','.'" Print #intFic, "SET,LAST" Print #intFic, "SET,FIRST" Print #intFic, "/PLOPTS,INFO,3" Print #intFic, "/CONTOUR,ALL,18" Print #intFic, "/PNUM,MAT,1" Print #intFic, "/NUMBER,1" Print #intFic, "/REPLOT,RESIZE" Print #intFic, "PLDISP , 1" Print #intFic, "ANDSCL , 30, 0.01" Print #intFic, "/SHOW,WIN32" Print #intFic, "/REPLOT,RESIZE" Close intFic End SubRE: CATVBA : Export Sketch Geometry to Excel
how long did it take you to master vba like this? and do you know any good internet resources for learning it?
(i am interested in catia and excel scripting primarily).
RE: CATVBA : Export Sketch Geometry to Excel
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: CATVBA : Export Sketch Geometry to Excel
I have some VB knowledge from a previous school project. For the rest I use the vb help (F1) and mostly common search on google. I was able to write a massive renaming script for Catia with some search and patience.
RE: CATVBA : Export Sketch Geometry to Excel
I worked out your code to get it. Now I have a better understanding of the object tree organization of Catia code (by the way, it works fine :) ).
RE: CATVBA : Export Sketch Geometry to Excel
But i'm on the R20 SP4 and the property "DisplayName" does not work...
With the proper replacements and R20 SP7 or higher should be working fine...
CODE -->
Sub Leer() Path = "C:\Alex\Book1.xlsx" Set Document = CATIA.ActiveDocument Dim oPart As Part Set oPart = Document.Part Dim oBody As Body Set oBody = oPart.Bodies.Item("PartBody") Dim oSketch As Sketch Set oSketch = oBody.Sketches.Item("Sketch.1") Set objExcel = CreateObject("Excel.Application") Set workbook = objExcel.Workbooks.Open(Path) objExcel.Cells(1, 1).Value = "Name" objExcel.Cells(1, 2).Value = "Type" objExcel.Cells(1, 3).Value = "1st Element" objExcel.Cells(1, 4).Value = "2nd Element" objExcel.Cells(1, 5).Value = "3rd Element" objExcel.Cells(1, 6).Value = "Dimension" Dim oConstraints As Constraints Set oConstraints = oSketch.Constraints For i = 1 To oConstraints.Count LastRow = objExcel.Range("A65536").End(xlUp).Row + 1 Set Cst1 = oConstraints.Item(i) objExcel.Cells(LastRow, 1).Value = Cst1.Name objExcel.Cells(LastRow, 2).Value = Cst1.Type If Cst1.Type = 1 Then Set Dime = Cst1.Dimension objExcel.Cells(LastRow, 6).Value = Dime.Value / 25.4 Else End If s = f(Cst1.Type) If s = 1 Then Set Dime = Cst1.Dimension objExcel.Cells(LastRow, 6).Value = Dime.Value / 25.4 Else End If For K = 1 To s Dim Ref1 As Reference Set Ref1 = Cst1.GetConstraintElement(K) ' Modifications For R20SP7 and higher s = Ref1.Name ' Delete this line ' Delete the "s" variable and put "Ref1.DisplayName" on the next line objExcel.Cells(LastRow, K + 2).Value = s ' Ref1.DisplayName Next K Next i End Sub Function f(a) Select Case a Case catCstTypeRadius, catCstTypeMajorRadius, catCstTypeMinorRadius, catCstTypeLength f = 1 Case catCstTypeDistance, catCstTypeOn, catCstTypeConcentricity, catCstTypeTangency, catCstTypeAngle, catCstTypeParallelism, catCstTypePerpendicularity, catCstTypeMidPoint, catCstTypeChamferPerpend, catCstTypeCylinderRadius f = 2 Case catCstTypeSymmetry, catCstTypeEquidistance, catCstTypeChamfer f = 3 End Select End Function