---

Hallo CAD-Community,

ich habe folgendes Problem: Ich habe ein Bauteil, bei dem ich vorhandene Löcher schließen möchte. Dazu erzeuge ich eine Boundary und schließe diese mit Hilfe von Fill's. Das ganze läuft über zwei Makros ab, wie in diesem Thread erwähnt: http://ww3.cad.de/foren/ubb/Forum133/HTML/008307.shtml

Nun habe ich das Problem, dass das Makro Boundarys erstellt, die keine geschlossenen Konturen aufweisen. Es taucht ein Updatefehler auf.

Frage: Gibt es ein Makro/Befehl mit dem man fehlerhafte Elemente einfach löschen oder deaktivieren kann?

vielen Dank im Voraus!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Guten Tag,

ich hatte mich vor einiger Zeit an das selbe Problem gemacht. Ich hatte dies als Automatisches UDF-Feature erstellt, also wurden dort an das VB-Script die Parameter in der Reaction übergeben. Diese müsstest du manuell Jüst selektieren (SelectElements2 oder so... dir überlassen).

Solltest du fragen dazu haben einfach melden. Habs noch halbwegs im gedächnis...

Aufbau (Ordner sind mit + gekennzeichnet)

Fuellfl+
-Input+
--Achse
--NullPunkt
--X-Line
--Y-Line
--Z-Line
--Zu Schließende Fläche
--Boundary der Fläche
-Work+
--Einzelumrisse+
--Fills+
-Ergebnis+
--Hilfsgeo5
--ErgebnisJoin

Code:

---

'bound, hbWork, hbResult, parInfo
'.Run(`Geometrical Set.2\Fuellfl\Input\Boundary.2`      ,`Geometrical Set.2\Fuellfl\Work`, `Geometrical Set.2\Fuellfl\Ergebnis` ,`Geometrical Set.2\Fuellfl\Parameters.2\Info`  )

'Set mPart = GetPart(hbWork) 'Ausführen außerhalb UDF
set mPart = parInfo.parent.parent 'Ausführung in UDF
call clear(hbWork.HybridBodies.Item(1),mPart)
call clear(hbWork.HybridBodies.Item(2),mPart)
call DisAss(bound,hbWork.HybridBodies.Item(1),mPart)
call CheckCurves(hbWork,bound,mPart)
call CreateFills(hbWork,bound.parent.item(6),mPart)
call JoinAll(hbResult.hybridshapes.item(1),hbWork.HybridBodies.Item(2),mPart)
call clear(hbResult.HybridBodies.Item(1),mPart)
call DisAss(hbResult.hybridshapes.item(1),hbResult.HybridBodies.Item(1),mPart)
call JoinAll(hbResult.hybridshapes.item(1),hbResult.HybridBodies.Item(1),mPart)
call clear(hbWork.HybridBodies.Item(1),mPart)
call clear(hbWork.HybridBodies.Item(2),mPart)
End Sub

Sub JoinAll(hsJoin,hbFills,mPart)
Set mHybridShapeFactory = mPart.HybridShapeFactory
for i = hsJoin.GetElementsSize to 1 Step -1
hsJoin.RemoveElement i
next
for i = 1 to hbFills.hybridshapes.count
Set ref_Fill = mPart.CreateReferenceFromObject(hbFills.hybridshapes.item(i))
hsjoin.AddElement ref_Fill
next
mPart.UpdateObject hsjoin
End Sub

Sub CheckCurves(hbWork,bound,mPart)
Set mHybridShapeFactory = mPart.HybridShapeFactory

'''Referenz-Richtungen für Extremum-Erstellung
Set hsDirX = bound.parent.item(3).Dir
Set hsDirY = bound.parent.item(4).Dir
Set hsDirZ = bound.parent.item(5).Dir

'''Referenz-Punkt erstellen - wird später weiter genutzt
Set ref_mCrv = mPart.CreateReferenceFromObject(bound)
Set hybridShapeExtremum1 = mHybridShapeFactory.AddNewExtremum(ref_mCrv, hsDirX, 1)
hybridShapeExtremum1.Direction2 = hsDirY
hybridShapeExtremum1.ExtremumType2 = 1
hybridShapeExtremum1.Direction3 = hsDirZ
hybridShapeExtremum1.ExtremumType3 = 1
mPart.UpdateObject hybridShapeExtremum1
refCoord = GetCoord(hybridShapeExtremum1,mPart)

'msgbox cstr(refCoord(0)) & ":" & cstr(refCoord(1)) & ":" & cstr(refCoord(2))

set hbCurves = hbWork.HybridBodies.Item(1)
for i = hbCurves.HybridShapes.count to 1 Step -1
Set ref_mCrv = mPart.CreateReferenceFromObject(hbCurves.hybridshapes.item(i))
'Extremum zum Vergleich erstellen
hybridShapeExtremum1.ReferenceElement = ref_mCrv
mPart.UpdateObject hybridShapeExtremum1
'Werte ermitteln und vergleichen
tarCoord = GetCoord(hybridShapeExtremum1,mPart)
if (tarcoord(0)=refCoord(0)) and (tarcoord(1)=refCoord(1)) and (tarcoord(2)=refCoord(2)) then
mHybridShapeFactory.DeleteObjectForDatum(ref_mCrv)
end if
next
end Sub

Function GetCoord(oP,mPart)
    Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench ( "SPAWorkbench" )
Set ref_oP = mPart.CreateReferenceFromObject(oP)
    Set TheMeasurable = TheSPAWorkbench.GetMeasurable(ref_oP)
Dim Coordinates(2)
    TheMeasurable.GetPoint Coordinates
GetCoord = Coordinates
end function

Sub DisAss(bound, hbWork,mPart)
Set mHybridShapeFactory = mPart.HybridShapeFactory
Set ref_mCrv = mPart.CreateReferenceFromObject(bound)

''' MUSS, DA BEI DIREKTER VERWENDUNG DER BOUND ALS UDF "ADDNEWDATUMS" AUF FEHLER LÄUFT!
Set assemble1 = mHybridShapeFactory.AddNewJoin(ref_mCrv, Nothing)
assemble1.SetConnex 0
mPart.UpdateObject assemble1
Set ref_mCrv = mPart.CreateReferenceFromObject(assemble1)

hShapes = mHybridShapeFactory.AddNewDatums(ref_mCrv)
For i4 = 0 To UBound(hShapes)
    hbWork.AppendHybridShape hShapes(i4)
Next
End Sub

Sub clear(hb_work,mPart)
Set mHybridShapeFactory = mPart.HybridShapeFactory
for i =  hb_work.hybridshapes.count to 1  Step -1
    Set ref_mCrv = mPart.CreateReferenceFromObject(hb_work.hybridshapes.item(i))
    mHybridShapeFactory.DeleteObjectForDatum(ref_mCrv)
next
End Sub

Function GetPart(hb)
set obj = hb
set GetPart = nothing
Do
    Set obj = obj.parent       
    If TypeName(obj) = "Part" Then Set GetPart = obj
Loop While GetPart Is Nothing
End Function

Sub CreateFills(hbWork,SurF,mPart)

Set mHybridShapeFactory = mPart.HybridShapeFactory
set hbFills = hbWork.HybridBodies.Item(2)
set hbCurves = hbWork.HybridBodies.Item(1)
Set ref_RefSurF = mPart.CreateReferenceFromObject(SurF)
for i = hbCurves.HybridShapes.count to 1 Step -1
Set ref_mCrv = mPart.CreateReferenceFromObject(hbCurves.hybridshapes.item(i))
Set hybridShapeFill1 = mHybridShapeFactory.AddNewFill()
hybridShapeFill1.AddBound ref_mCrv
hybridShapeFill1.AddSupportAtBound ref_mCrv, ref_RefSurF
hybridShapeFill1.Continuity = 1
hbFills.AppendHybridShape hybridShapeFill1
mPart.UpdateObject hybridShapeFill1
next

End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP