Reference Issue
Reference Issue
(OP)
hi every body,
i dont really know how to solve this, my code count the faces of the part and calculate the area of the surface but some how is not getting the reference
hope you can help me.
Sub CATMain()
CATIA.ActiveDocument.Selection.Clear
Set objsel = CATIA.ActiveDocument.Selection
objsel.Search "Type=Topology.Face,all"
icnt = objsel.Selection.Count
ReDim MySurface(icnt + 1)
For o = 1 To icnt
Set MySurface(o) = objsel.Item(o).Value
Next
For o = 1 To icnt
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set Selection = partDocument1.Selection
Set ref1 = objsel.Item(MySurface(o)).Reference
Set spabench = partDocument1.GetWorkbench("SPAWorkbench")
Set mymeas = spabench.GetMeasurable(ref1)
myans = mymeas.Area
data_file.WriteLine (myans)
Next
End Sub
i dont really know how to solve this, my code count the faces of the part and calculate the area of the surface but some how is not getting the reference
hope you can help me.
Sub CATMain()
CATIA.ActiveDocument.Selection.Clear
Set objsel = CATIA.ActiveDocument.Selection
objsel.Search "Type=Topology.Face,all"
icnt = objsel.Selection.Count
ReDim MySurface(icnt + 1)
For o = 1 To icnt
Set MySurface(o) = objsel.Item(o).Value
Next
For o = 1 To icnt
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set Selection = partDocument1.Selection
Set ref1 = objsel.Item(MySurface(o)).Reference
Set spabench = partDocument1.GetWorkbench("SPAWorkbench")
Set mymeas = spabench.GetMeasurable(ref1)
myans = mymeas.Area
data_file.WriteLine (myans)
Next
End Sub





RE: Reference Issue
I just recognize some portions of codes and add some others...
CODE --> CATScript
Sub CATMain() Dim objNet Set filesys = CATIA.FileSystem strFile = "c:\temp\Areas.txt" Const ForAppending = 8 set objFSO = CreateObject("Scripting.FileSystemObject") set objFile = objFSO.OpenTextFile(strFile, ForAppending, True) Set objNet = CreateObject("WScript.NetWork") Set partDocument1 = CATIA.ActiveDocument Set part1 = partDocument1.Part Set Selection = partDocument1.Selection Set spabench = partDocument1.GetWorkbench("SPAWorkbench") Set objsel = CATIA.ActiveDocument.Selection objsel.Clear objsel.Search "Type=Topology.Face,all" X = objsel.Count2 For i = 1 To X Set reference1 = Selection.Item(i).Reference Set mymeas = spabench.GetMeasurable(reference1) objFile.writeLine("Name of selection : " & reference1.name & " ; " & "Area is :" & " " & mymeas.Area & vbcrlf) Next objFile.Close End SubRegards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: Reference Issue
thank you so much for your helpful response, the code is running perfectly and fast, when i am trying to count the edges of a face it only runs once, and i have issue with the reference again
can you help me find where my error is
thank you so much, here is the code i am using, at the end is where i start counting the edges
Language="VBSCRIPT"
Dim arrayOfVariantOfBSTR1(0)
Dim selection1
Dim partDocument1
Dim bSTR3
Dim bSTR1
Dim bSTR2
Dim oTopProductDoc
Dim oTopProduct
Dim Count
Dim visProperties1
Dim icnt
Dim MySurface
Dim MySelection
Dim o
Dim spabench
Dim mymeas
Dim centroide
Dim ref1
Dim myans
Dim InputObjectType(0)
Dim variable
Dim ActWin
Dim v3d
Dim specs
Dim ObjViewer3D
Dim filesys, testfile
Dim varlinea
Dim objCamera3D
Dim exten
Dim objSpecWindow
Dim fileloc
Dim strName
Dim hybridShapeFactory1
Dim bodies1
Dim body1
Dim shapes1
Dim solid1
Dim reflinea2
Dim var
Dim reflinea1
Dim hybridShapes1
Dim hybridShapeLineNormal1
Dim hybridShapePointCoord1
Dim vector(2)
Dim refdir
Dim mycoord(2)
Dim coord
Dim punto
Dim osel
Dim oFace
Dim FaceParent
Dim aFaceName
Dim sFaceName1
Dim oFoundEdges
Dim iFoundEdges
Dim sEdgeName
Dim aEdgeName
Dim Edge
Dim sFaceName2
Dim obj
Dim Folder
Dim ruta
Dim Cont
Dim RutaMacro
Dim objNet
Sub CATMain()
Set filesys = CATIA.FileSystem
strFile = "C:\Users\Lab3\Desktop\PARA TRABAJAR\Areas.txt"
Const ForAppending = 8
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile(strFile, ForAppending, True)
Set objNet = CreateObject("WScript.NetWork")
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set Selection = partDocument1.Selection
Set spabench = partDocument1.GetWorkbench("SPAWorkbench")
Set objsel = CATIA.ActiveDocument.Selection
objsel.Clear
objsel.Search "Type=Topology.Face,all"
X = objsel.Count2
objFile.WriteLine (X)
For i = 1 To X
Set reference1 = Selection.Item(i).Reference
Set mymeas = spabench.GetMeasurable(reference1)
objFile.writeLine(mymeas.Area)
Set centroide = spabench.GetMeasurable(reference1)
centroide.GetCOG mycoord
xc = mycoord(0)
yc = mycoord(1)
zc = mycoord(2)
objFile.WriteLine (mycoord(0))
objFile.WriteLine (mycoord(1))
objFile.WriteLine (mycoord(2) & vbcrlf)
Set punto = part1.HybridShapeFactory
Set coord = punto.AddNewPointCoord(xc, yc, zc) 'Variables
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
hybridBody1.AppendHybridShape coord
part1.Update
'*************Crea el Vector de Direccion************************************
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("Pieza.1")
Set shapes1 = body1.Shapes
Set solid1 = shapes1.Item("Pieza.1")
Set reflinea2 = part1.CreateReferenceFromObject(coord)
Set reflinea1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Pieza.1;" + CStr(i) + ");None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", solid1)
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapePointCoord1 = hybridShapes1.Item("Point." & i)
Set hybridShapeLineNormal1 = hybridShapeFactory1.AddNewLineNormal(reflinea1, reflinea2, 0, 5, True)
hybridBody1.AppendHybridShape hybridShapeLineNormal1
part1.InWorkObject = hybridShapeLineNormal1
Part1.Update
Set refdir = part1.CreateReferenceFromObject(hybridShapeLineNormal1)
Set direccion = spabench.GetMeasurable(refdir)
direccion.GetDirection vector
objFile.WriteLine (vector(0))
objFile.WriteLine (vector(1))
objFile.WriteLine (vector(2)& vbcrlf)
'******************Cuenta las Aristas de la Cara******************************
Set osel2 = CATIA.ActiveDocument.Selection
Set oFace = osel2.Item(i).Value
Set FaceParent = oFace.Parent
aFaceName = Split(oFace.name, "Selection_RSur:(Face:(")
sFaceName1 = aFaceName(UBound(aFaceName))
aFaceName = Split(sFaceName1, ";" & FaceParent.name & ";")
sFaceName1 = aFaceName(0)
sFaceName2 = aFaceName(UBound(aFaceName))
osel2.Clear
osel2.Add FaceParent
osel2.Search ("Topology.Edge,sel")
iFoundEdges = 0
Set oFoundEdges = CreateObject("Scripting.Dictionary")
For j = 1 To osel2.Count
sEdgeName = osel2.Item(j).Value.Name
aEdgeName = Split(sEdgeName, "face")
sEdgeName = "face" & aEdgeName(UBound(aEdgeName))
If InStr(sEdgeName,sFaceName1) <> 0 And InStr(sEdgeName,sFaceName2) <> 0 Then
Set Edge = osel2.Item(j).Value
oFoundEdges.Add j, Edge
iFoundEdges = iFoundEdges + 1
End If
Next
osel2.Clear
If Not iFoundEdges = 0 Then
objFile.WriteLine (iFoundEdges)
'Else
'MsgBox "La figura no tiene aristas"
End If
varlinea = varlinea - 1
'Borra lineas y puntos
'******************************* variables *******************************************
Set objNetwork = CreateObject("Wscript.Network")
Set hybridBody1 = CATIA.ActiveDocument.Part.InWorkObject
Set hybridShapeFactory1 = CATIA.ActiveDocument.Part.HybridShapeFactory
Set SPAWorkBench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
selection1.Clear
Set part1 = partDocument1.Part
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
selection1.Add hybridBody1
CATIA.ActiveDocument.Selection.Search("t:curve + t:point + t:plane,sel")
if(CATIA.ActiveDocument.Selection.count<1)then
msgbox "empty selection" & vbCrLf & "select some curve(s),point(s),plane(s) and run this script again", ,msgboxtext
else
CATIA.ActiveDocument.Selection.Delete
end if
Part1.Update
Next
objFile.Close
End Sub
RE: Reference Issue
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: Reference Issue
whant i want to do i to extract all the possible geometry from a selected face in a TXT, because we want to create a program that analyse in a different program, and it has to do it automaticly, so i found that CATIA and the other program does not count in the same way, so if i want to tell the the face number 2 has a force, in CATIA i know what is the face number 2, but in the other program might change,
so, i hope i gave you an idea of what i am trying to do since my english is not so good,
thank you for all your help
Dim Language
Language="VBSCRIPT"
Sub CATMain()
Dim colDocum
Dim DocActivo
Dim part1
Dim colBodies
Dim hSFact
Dim colHBody
Dim OpenBody1
Dim sStatus
Dim mySelection
Dim InputObjectType(0)
InputObjectType(0) = "Face"
Dim refBorde
Set DocActivo = CATIA.ActiveDocument
Set part1 = DocActivo.Part
Set mySelection = DocActivo.Selection
Set hSFact = part1.HybridShapeFactory
Set colBodies = part1.Bodies
Status = mySelection.SelectElement2(InputObjectType, "Select a Face or hit ESCAPE: ", True)
If (Status = "Cancel") Then
Exit Sub
End If
Set refBorde = mySelection.Item(1).Value
Dim hybridShapeExtract1
Set hybridShapeExtract1 = hSFact.AddNewExtract(refBorde)
hybridShapeExtract1.PropagationType = 3
hybridShapeExtract1.ComplementaryExtract = False
hybridShapeExtract1.IsFederated = False
Set refBorde = hybridShapeExtract1
hybridShapeExtract1.Name ="Extracted_Face"
''''' Create Open Body
Dim HB1
Set HB1 = CATIA.ActiveDocument.Part.HybridBodies
Dim Hierarchie1, ImKoerper
Set Hierarchie1 = HB1.Add
Hierarchie1.Name = "Extracted_Elements"
''''''''
Set colHBody = part1.HybridBodies
Set OpenBody1 = part1.InWorkObject
OpenBody1.AppendHybridShape hybridShapeExtract1
part1.InWorkObject = hybridShapeExtract1
part1.Update
mySelection.Clear
mySelection.Add(hybridShapeExtract1)
Dim partDocument1
Set partDocument1 = CATIA.ActiveDocument
Dim selection1
Set selection1 = partDocument1.Selection
selection1.Search "Topology.CGMEdge,sel"
MsgBox selection1.Count2 & " Edges are found from the selected face"
End Sub
RE: Reference Issue
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: Reference Issue
RE: Reference Issue
i have a part thet hace 270 surfaces, and extracting and count one by one is taking a long time
hope some body can help me, thank you
RE: Reference Issue
If you are working with igs files and want to find only the number of the surfaces and edges, the fastest way is just search, count and display their number without any extraction.
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: Reference Issue
for now i just have two ways of serching for the edges of a surface and for the igs file that i have its taking like 30 por 40 minutes, the codes are below,
is there a faster way? if so, could you guide how to do it, i am lost,
thank you
CODE # 1
Dim Language
Language="VBSCRIPT"
Sub CATMain()
Dim colDocum
Dim DocActivo
Dim part1
Dim colBodies
Dim hSFact
Dim hybridShapeExtract1
Dim HB1
Dim Hierarchie1, ImKoerper
Dim partDocument1
Dim selection1
Dim colHBody
Dim OpenBody1
Dim sStatus
Dim mySelection
Dim InputObjectType(0)
InputObjectType(0) = "Face"
Dim refBorde
Const ForAppending = 8
Set filesys = CATIA.FileSystem
strFile = "C:\Users\Lab3\Desktop\PARA TRABAJAR\aristas.txt"
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile(strFile, ForAppending, True)
Set objNet = CreateObject("WScript.NetWork")
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set Selection = partDocument1.Selection
Set spabench = partDocument1.GetWorkbench("SPAWorkbench")
Set objsel = CATIA.ActiveDocument.Selection
objsel.Clear
objsel.Search "Type=Topology.Face,all"
X = objsel.Count2
objFile.WriteLine (X)
Set HB1 = CATIA.ActiveDocument.Part.HybridBodies
Set Hierarchie1 = HB1.Add
Hierarchie1.Name = "Extracted_Elements"
For i = 1 to X
CATIA.ActiveDocument.Selection.Clear
Set objsel = CATIA.ActiveDocument.Selection
objsel.Search "Type=Topology.Face,all"
Set DocActivo = CATIA.ActiveDocument
Set part1 = DocActivo.Part
Set mySelection = DocActivo.Selection
Set hSFact = part1.HybridShapeFactory
Set colBodies = part1.Bodies
Set refBorde = mySelection.Item(i).Value
Set hybridShapeExtract1 = hSFact.AddNewExtract(refBorde)
hybridShapeExtract1.PropagationType = 3
hybridShapeExtract1.ComplementaryExtract = False
hybridShapeExtract1.IsFederated = False
Set refBorde = hybridShapeExtract1
hybridShapeExtract1.Name ="Extracted_Face"
Set colHBody = part1.HybridBodies
Set OpenBody1 = part1.InWorkObject
OpenBody1.AppendHybridShape hybridShapeExtract1
part1.InWorkObject = hybridShapeExtract1
part1.Update
mySelection.Clear
mySelection.Add(hybridShapeExtract1)
Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
selection1.Search "Topology.CGMEdge,sel"
objFile.WriteLine (selection1.Count2)
MsgBox selection1.Count2 & " Edges are found from the selected face"
Next
End Sub
CODE # 2
CATIA.ActiveDocument.Selection.Clear
Set objsel = CATIA.ActiveDocument.Selection
objsel.Search "Type=Topology.Face,all"
Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
icnt = objsel.Selection.Count
ReDim MySurface(icnt + 1)
For oo = 1 To icnt
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set Selection = partDocument1.Selection
Set objsel = CATIA.ActiveDocument.Selection
objsel.Clear
objsel.Search "Type=Topology.Face,"&oo
Set ref1 = Selection.Item(oo).Reference
Set osel2 = CATIA.ActiveDocument.Selection
Set oFace = osel2.Item(oo).Value
Set FaceParent = oFace.Parent
aFaceName = Split(oFace.name, "Selection_RSur:(Face:(")
sFaceName1 = aFaceName(UBound(aFaceName))
aFaceName = Split(sFaceName1, ";" & FaceParent.name & ";")
sFaceName1 = aFaceName(0)
sFaceName2 = aFaceName(UBound(aFaceName))
osel2.Clear
osel2.Add FaceParent
osel2.Search ("Topology.Edge,sel")
iFoundEdges = 0
Set oFoundEdges = CreateObject("Scripting.Dictionary")
For j = 1 To osel2.Count
sEdgeName = osel2.Item(j).Value.Name
aEdgeName = Split(sEdgeName, "face")
sEdgeName = "face" & aEdgeName(UBound(aEdgeName))
If InStr(sEdgeName,sFaceName1) <> 0 And InStr(sEdgeName,sFaceName2) <> 0 Then
Set Edge = osel2.Item(j).Value
oFoundEdges.Add j, Edge
iFoundEdges = iFoundEdges + 1
End If
Next
osel2.Clear
If Not iFoundEdges = 0 Then
data_file.WriteLine (iFoundEdges)
'Else
'MsgBox "La figura no tiene aristas"
End If
varlinea = varlinea - 1
'if oo = 5 then
'oo = icnt
'end if
Next
RE: Reference Issue
CODE --> CATScript
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...