Reference Issue

[lapek]

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

 

[ferdo]

Hi,

I just recognize some portions of codes and add some others...

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 Sub

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[lapek]

hi ferdo

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("RSurFaceBrpPieza.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_RSurFace")
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 + toint + tlane,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

 

[ferdo]

I suggest you first to extract the faces, rename them somehow, then count the edges of each extracted face. In fact, what is your final goal and what do you want to do? Try to create rivets symbols?

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[lapek]

yes i just saw a post with the following code, thank you so much for your respose,

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

 

[ferdo]

Did you tried to work with a common neutral file like igs for example ? You don't need a special license to save a part as igs....

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[lapek]

yes actually when doing the macro i open the cat part and convert it as a IGS and i work like that, but as you can see i am not to familiar with the vbs, and some times im lost,

 

[lapek]

is there a faster way to count the edges of a surface?

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

 

[ferdo]

HI,

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/

 

[lapek]

hi ferdo

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_RSurFace")
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

 

[ferdo]

You really need to say what you want....below I'm just counting surfaces in an igs files (all surfaces has name like Surface.1 , Surface.2 a.s.o. ...) and their edges...for 55 surfaces take just few seconds...try to understand all those lines of code, do not just copy and paste.

Language="VBSCRIPT"

Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = partDocument1.Selection
selection1.Search "Name=Surface*,all"

X = selection1.Count2

Dim selection2 As Selection
Set selection2 = partDocument1.Selection
selection2.Search "Topology.CGMEdge,sel"

Y = selection2.Count2

MsgBox "You have here " & X & " unique surfaces " & "and " & Y & " unique edges"

End Sub

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/