Egalware/egtstone3d
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ScriptEditor
egtstone3d/Utility/EstCalc.vb
T
Demetrio Cassarino 015d543937 -piccole modifiche e correzioni
2025-01-07 15:55:05 +01:00

1102 lines
47 KiB
VB.net
Raw Permalink Blame History

Imports System.Globalization
Imports EgtUILib
Module EstCalc
#Region "METHODS"
'Friend Function CompoColor(sIniFile As String) As Color3d
' Dim InsertColor As New Color3d(89, 210, 210, 25)
' Dim IndexColor As Integer = GetPrivateProfileInt(S_COMPO, K_LASTCOLOR, 1, sIniFile)
' If Not GetPrivateProfileColor(S_COMPO, K_COLOR & IndexColor.ToString, InsertColor, sIniFile) Then
' IndexColor = 1
' GetPrivateProfileColor(S_COMPO, K_COLOR & IndexColor.ToString, InsertColor, sIniFile)
' End If
' WritePrivateProfileString(S_COMPO, K_LASTCOLOR, (IndexColor + 1).ToString, sIniFile)
' Return InsertColor
'End Function
'--------------------------------------------------------------------------------------------------
Friend Function DoubleToString(ByVal dVal As Double, ByVal nNumDec As Integer) As String
Dim sFormat As String = "F" + Math.Abs(nNumDec).ToString()
Dim sVal As String = dVal.ToString(sFormat, CultureInfo.InvariantCulture)
If nNumDec > 0 Then
Return sVal.TrimEnd("0".ToCharArray()).TrimEnd(".".ToCharArray)
Else
Return sVal
End If
End Function
Friend Function StringToDouble(ByVal sVal As String, ByRef dVal As Double) As Boolean
If String.IsNullOrEmpty(sVal) Then Return False
Return EgtLuaEvalNumExpr(sVal, dVal)
End Function
Friend Function StringToInt(sVal As String, ByRef nVal As Integer) As Boolean
Dim dVal As Double = 0
If Not StringToDouble(sVal, dVal) Then Return False
nVal = CInt(Math.Round(dVal))
Return True
End Function
Friend Function LenToString(ByVal dVal As Double, ByVal nNumDec As Integer) As String
Return DoubleToString(EgtToUiUnits(dVal), nNumDec)
End Function
Friend Function StringToLen(ByVal sVal As String, ByRef dVal As Double) As Boolean
If String.IsNullOrEmpty(sVal) Then Return False
If EgtLuaEvalNumExpr(sVal, dVal) Then
dVal = EgtFromUiUnits(dVal)
Return True
Else
Return False
End If
End Function
#Region "PreGuidCode"
' recupero i primi 5 caratteri della stringa
Friend Function GetPreGuidCode(sGuidCode As String) As String
If sGuidCode.Count > 5 Then
Return sGuidCode(0) & sGuidCode(1) & sGuidCode(2) & sGuidCode(3) & sGuidCode(4)
End If
Return String.Empty
End Function
' sostituisce i primi 5 caratteri della stringa con qualle passata
Friend Function UppDateGuidCode(ByRef sGuidCode As String, sPreGuidCode As String) As Boolean
If sPreGuidCode.Count = 5 Then
sGuidCode = sGuidCode.Remove(0, 5)
sGuidCode = sPreGuidCode & sGuidCode
Return True
End If
Return False
End Function
' restituisce 5 caratteri
Friend Function CreatePreGuidCode(nId As Integer) As String
' recupero il frame dell'oggetto
Dim frGlobFrame As New Frame3d
If Not EgtGetGroupGlobFrame(nId, frGlobFrame) Then
Return String.Empty
End If
' recupero il suo versore
Dim vtX As Vector3d = frGlobFrame.VersX
Dim Len As Double
Dim AngV As Double
Dim AngH As Double
vtX.ToSpherical(Len, AngV, AngH)
' costruisco il codice (6 caratteri!) che identifica la posizione del pezzo in parcheggio
Dim sPreGuid As String = GetDirectionCode(AngH)
Return sPreGuid
End Function
Friend Function GetDirectionCode(dVal As Double) As String
Dim bIsNegative As Boolean = False
If dVal < 0 Then
dVal = dVal + (-1)
bIsNegative = True
End If
Dim sVal As String = DoubleToString(dVal * 1000, 0)
Dim nCount As Integer = sVal.Count
For Index As Integer = 1 To 4 - nCount
sVal = "0" & sVal
Next
Dim vVal As Char() = {"+"c, "1"c, "0"c, "0"c, "0"c}
If bIsNegative Then
vVal = {"-"c, sVal(0), sVal(1), sVal(2), sVal(3)}
Else
vVal = {"+"c, sVal(0), sVal(1), sVal(2), sVal(3)}
End If
' ricostruisco la stringa dotata di segno
sVal = vVal(0) & vVal(1) & vVal(2) & vVal(3) & vVal(4)
Return sVal
End Function
#End Region ' PreGiudCode
'--------------------------------------------------------------------------------------------------
Private m_nRawId As Integer = GDB_ID.NULL
Public Function GetRawId() As Integer
Return m_nRawId
End Function
Private m_b3Raw As New BBox3d
Public Function GetRawPtMin() As Point3d
If m_b3Raw.IsEmpty() Then Return Point3d.ORIG()
Return m_b3Raw.Min()
End Function
Public Function GetRawPtMax() As Point3d
If m_b3Raw.IsEmpty() Then Return Point3d.ORIG()
Return m_b3Raw.Max()
End Function
Public Function GetRawLength() As Double
Return m_b3Raw.DimX()
End Function
Public Function GetRawWidth() As Double
Return m_b3Raw.DimY()
End Function
Public Function GetRawHeight() As Double
Return m_b3Raw.DimZ()
End Function
'Public Function UpdateRawPart() As Boolean
' ' Passo al contesto principale
' EgtSetCurrentContext(OmagOFFICEMap.refSceneHostVM.MainScene.GetCtx())
' ' determino il grezzo (è il primo con fase 1)
' m_nRawId = CamAuto.GetCurrentRaw()
' If Not EgtGetRawPartBBox(m_nRawId, m_b3Raw) Then
' m_nRawId = GDB_ID.NULL
' m_b3Raw.Setup()
' End If
' Return (m_nRawId <> GDB_ID.NULL)
'End Function
''--------------------------------------------------------------------------------------------------
'Public Function SetMaterialName() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' If Not IsNothing(CurrentMachine.CurrMat) Then
' Return EgtSetInfo(nMGrpId, INFO_PROJMAT, CurrentMachine.CurrMat.sName)
' Else
' Return EgtSetInfo(nMGrpId, INFO_PROJMAT, "")
' End If
'End Function
'Public Function SetMaterialPhoto(sMatDB As String) As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' ' insesrisco il nome del materiale letto dal DB
' If Not String.IsNullOrEmpty(sMatDB) Then
' Return EgtSetInfo(nMGrpId, INFO_PHOTOMAT, sMatDB)
' Else
' Return False
' End If
'End Function
'Friend Function GetMaterialName() As String
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim sName As String = String.Empty
' EgtGetInfo(nMGrpId, INFO_PROJMAT, sName)
' Return sName
'End Function
'Friend Function GetMaterialPhoto() As String
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim sName As String = String.Empty
' If EgtGetInfo(nMGrpId, INFO_PHOTOMAT, sName) Then
' Return sName
' Else
' Return String.Empty
' End If
'End Function
''--------------------------------------------------------------------------------------------------
'Public Function SetSlabName(sSlabName As String) As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Return EgtSetInfo(nMGrpId, INFO_SLABNAME, sSlabName)
'End Function
'Friend Function GetSlabName() As String
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim sSlabName As String = ""
' EgtGetInfo(nMGrpId, INFO_SLABNAME, sSlabName)
' Return sSlabName
'End Function
'Public Function SetBlockCode(sBlockCode As String) As Boolean
' Dim nRawId As Integer = EstCalc.GetRawId()
' Return EgtSetInfo(nRawId, INFO_RAW_BLOCK, sBlockCode)
'End Function
'Public Function SetSlabCode(sSlabCode As String) As Boolean
' Dim nRawId As Integer = EstCalc.GetRawId()
' Return EgtSetInfo(nRawId, INFO_RAW_SLABNBR, sSlabCode)
'End Function
''--------------------------------------------------------------------------------------------------
'Public Function SetSlabHeight(dSlabHeight As Double) As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Return EgtSetInfo(nMGrpId, INFO_SLABHEIGHT, dSlabHeight)
'End Function
'Friend Function GetSlabHeight() As Double
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim dSlabHeight As Double = 0
' EgtGetInfo(nMGrpId, INFO_SLABHEIGHT, dSlabHeight)
' Return dSlabHeight
'End Function
''--------------------------------------------------------------------------------------------------
'Friend Function ShowBarCode( nRawId As Integer, sBarCode As String) As Boolean
' ' Cancello eventuale vecchio BarCode
' EgtErase(EgtGetFirstNameInGroup(nRawId, NAME_BARCODE))
' ' Se definito, inserisco nuovo BarCode
' If Not String.IsNullOrWhiteSpace( sBarCode) AndAlso sBarCode <> " - " Then
' Dim ptRawCen As Point3d
' GetRawCenter(ptRawCen)
' Dim ptRawMin, ptRawMax As Point3d
' GetRawBox(ptRawMin, ptRawMax)
' Dim ptText As New Point3d(ptRawCen.x, ptRawCen.y, ptRawMax.z)
' Dim nText As Integer = EgtCreateTextAdv(nRawId, ptText, 0, sBarCode, "", 500, False, 50.0, 1, 0, INS_POS.MC, GDB_RT.GLOB)
' EgtSetName(nText, NAME_BARCODE)
' EgtSetColor(nText, New Color3d(255, 0, 0))
' Return True
' Else
' Return False
' End If
'End Function
''--------------------------------------------------------------------------------------------------
'Friend Function SetCurrSawing(sCurrSawing As String) As Boolean
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return False
' Return EgtSetInfo(nOperId, INFO_CURRSAWING, sCurrSawing, True)
'End Function
'Friend Function GetCurrSawing() As String
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return ""
' Dim sCurrSawing As String = String.Empty
' EgtGetInfo(nOperId, INFO_CURRSAWING, sCurrSawing)
' Return sCurrSawing
'End Function
'Friend Function SetCurrMilling(sCurrMilling As String) As Boolean
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return False
' Return EgtSetInfo(nOperId, INFO_CURRMILLING, sCurrMilling, True)
'End Function
'Friend Function GetCurrMilling() As String
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return ""
' Dim sCurrMilling As String = String.Empty
' EgtGetInfo(nOperId, INFO_CURRMILLING, sCurrMilling)
' Return sCurrMilling
'End Function
'Friend Function SetCurrDrilling(sCurrDrilling As String) As Boolean
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return False
' Return EgtSetInfo(nOperId, INFO_CURRDRILLING, sCurrDrilling, True)
'End Function
'Friend Function GetCurrDrilling() As String
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return ""
' Dim sCurrDrilling As String = String.Empty
' EgtGetInfo(nOperId, INFO_CURRDRILLING, sCurrDrilling)
' Return sCurrDrilling
'End Function
'Friend Function SetCurrPocketing(sCurrMilling As String) As Boolean
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return False
' Return EgtSetInfo(nOperId, INFO_CURRPOCKETING, sCurrMilling, True)
'End Function
'Friend Function GetCurrPocketing() As String
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return ""
' Dim sCurrPocketing As String = String.Empty
' EgtGetInfo(nOperId, INFO_CURRPOCKETING, sCurrPocketing)
' Return sCurrPocketing
'End Function
'Friend Function SetCurrWaterjetting(sCurrMilling As String) As Boolean
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return False
' Return EgtSetInfo(nOperId, INFO_CURRWATERJETTING, sCurrMilling, True)
'End Function
'Friend Function GetCurrWaterjetting() As String
' Dim nOperId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), "Opers")
' If nOperId = GDB_ID.NULL Then Return ""
' Dim sCurrWaterjetting As String = String.Empty
' EgtGetInfo(nOperId, INFO_CURRWATERJETTING, sCurrWaterjetting)
' Return sCurrWaterjetting
'End Function
''--------------------------------------------------------------------------------------------------
'Public Function SetOrderMachiningFlag() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Return EgtSetInfo(nMGrpId, INFO_MACHORDER, 1)
'End Function
'Friend Function ResetOrderMachiningFlag() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Return EgtRemoveInfo(nMGrpId, INFO_MACHORDER)
'End Function
'Friend Function GetOrderMachiningFlag() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim nFlag As Integer = 0
' EgtGetInfo(nMGrpId, INFO_MACHORDER, nFlag)
' Return (nFlag <> 0)
'End Function
'Public Function AdjustAdditionalTable() As Boolean
' ' Recupero altezza sottotavola corrente
' Dim nFixtId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), MACH_FIXT_GROUP)
' Dim nAddTabId As Integer = EgtGetFirstNameInGroup(nFixtId, MACH_ADD_TABLE)
' Dim dCurrAddTab As Double = 0
' If nAddTabId <> GDB_ID.NULL And Not EgtGetInfo(nAddTabId, KEY_ADD_TABLE, dCurrAddTab) Then
' Dim b3AddTab As New BBox3d
' EgtGetBBoxGlob(nAddTabId, GDB_BB.STANDARD, b3AddTab)
' dCurrAddTab = b3AddTab.DimZ()
' End If
' ' Se valore cambiato, aggiorno...
' Dim dDeltaZ As Double = dAdditionalTable - dCurrAddTab
' If Math.Abs(dDeltaZ) > EPS_SMALL Then
' AddAdditionalTable()
' UpdateAllRawsZ(dDeltaZ)
' ' !!! FOTO DA GESTIRE !!!
' 'If GetPhoto() <> GDB_ID.NULL Then
' ' UpdatePhoto()
' ' UpdateContour()
' ' If EgtGetRawPartCount() > 0 Then
' ' ShowPhoto(False)
' ' End If
' 'End If
' End If
' Return True
'End Function
'Public Function AddAdditionalTable() As Boolean
' ' Gruppo dei sottopezzi
' Dim nFixtId As Integer = EgtGetFirstNameInGroup(EgtGetCurrMachGroup(), MACH_FIXT_GROUP)
' ' Elimino eventuale vecchia tavola dal gruppo dei bloccaggi
' EgtErase(EgtGetFirstNameInGroup(nFixtId, MACH_ADD_TABLE))
' ' Altezza eventuale tavola aggiuntiva
' Dim dAddTable As Double = dAdditionalTable
' ' Se non richiesta sovratavola, non c'è altro da fare ed esco
' If dAddTable < 10 * EPS_SMALL Then Return True
' ' Recupero box tavola
' Dim ptMin, ptMax As Point3d
' EgtGetTableArea(1, ptMin, ptMax)
' ' Nuova geometria
' Dim nAddTabId As Integer = GDB_ID.NULL
' ' Se esiste geometria di riferimento
' Dim nRefAddTabId = EgtGetFirstNameInGroup(EgtGetFirstNameInGroup(EgtGetTableId(MAIN_TAB), "SOLID"), MACH_ADD_TABLE)
' If nRefAddTabId <> GDB_ID.NULL Then
' nAddTabId = EgtCopyGlob(nRefAddTabId, nFixtId)
' EgtSetStatus(nAddTabId, GDB_ST.ON_)
' EgtScale(nAddTabId, New Frame3d(ptMin), 1, 1, dAddTable / 10)
' ' altrimenti la creo
' Else
' ' Aggiungo sovratavola nel gruppo dei bloccaggi
' ptMax.z -= DELTAZ_ADDTAB
' ptMin.z = ptMax.z
' ptMax.z += dAddTable
' nAddTabId = EgtCreateSurfTmBBox(nFixtId, ptMin, ptMax, GDB_RT.GLOB)
' End If
' ' Sistemazioni finali
' If nAddTabId = GDB_ID.NULL Then Return False
' EgtSetName(nAddTabId, MACH_ADD_TABLE)
' EgtSetColor(nAddTabId, New Color3d(150, 75, 0, 100), True)
' EgtSetInfo(nAddTabId, KEY_ADD_TABLE, dAddTable)
' Return True
'End Function
'Public Function SetWashingFlag(bWash As Boolean) As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Return EgtSetInfo(nMGrpId, INFO_WASHING, bWash)
'End Function
'Public Function GetWashingFlag() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim bFlag As Boolean = True
' EgtGetInfo(nMGrpId, INFO_WASHING, bFlag)
' Return bFlag
'End Function
'Public Function UpdateWashingFlag() As Boolean
' Dim bCurrWash As Boolean = ( CurrentMachine.nWashing <> 0)
' Dim bProjWash As Boolean = GetWashingFlag()
' If bCurrWash <> bProjWash Then Return SetWashingFlag(bCurrWash)
' Return True
'End Function
'Public Function SetSideAngCutProbeFlag(bSacProbe As Boolean) As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' If bSacProbe Then
' Return EgtSetInfo(nMGrpId, INFO_SACPROBE, True)
' Else
' Return EgtRemoveInfo(nMGrpId, INFO_SACPROBE)
' End If
'End Function
'Public Function GetSideAngCutProbeFlag() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim bFlag As Boolean = False
' EgtGetInfo(nMGrpId, INFO_SACPROBE, bFlag)
' Return bFlag
'End Function
'Public Function UpdateSideAngCutProbeFlag() As Boolean
' Dim bCurrSacProbe As Boolean = ( CurrentMachine.nSacProbe > 0)
' Dim bProjSacProbe As Boolean = GetSideAngCutProbeFlag()
' If bCurrSacProbe <> bProjSacProbe Then Return SetSideAngCutProbeFlag(bCurrSacProbe)
' Return True
'End Function
'Public Function SetReducedCut(bReduced As Boolean) As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Return EgtSetInfo(nMGrpId, INFO_REDUCEDCUT, bReduced)
'End Function
'Public Function GetReducedCut() As Boolean
' Dim nMGrpId As Integer = EgtGetCurrMachGroup()
' Dim bFlag As Boolean = False
' EgtGetInfo(nMGrpId, INFO_REDUCEDCUT, bFlag)
' Return bFlag
'End Function
''--------------------------------------------------------------------------------------------------
'Public Function PartIsFree(nId As Integer) As Boolean
' ' Deve essere un pezzo
' If Not EgtIsPart(nId) Then Return False
' ' Non deve essere inserito in grezzi della prima fase di qualche gruppo di lavoro
' Dim sList As String = String.Empty
' If Not EgtGetInfo(nId, "!LST", sList) Then Return True
' Dim sItems() As String = sList.Split(",".ToCharArray)
' If sItems.Count() = 0 Then Return True
' For Each sLstId In sItems
' Dim nLstId As Integer = GDB_ID.NULL
' StringToInt(sLstId, nLstId)
' Dim nRawId = EgtGetParent(nLstId)
' Dim nPhase As Integer = 1
' EgtGetInfo(nRawId, "Ph", nPhase)
' If nPhase = 1 Then
' Dim sName As String = String.Empty
' If EgtGetName(EgtGetParent(nRawId), sName) AndAlso sName = MACH_RAWS_GROUP Then Return False
' End If
' Next
' Return True
'End Function
'Public Function GetPartMachGroup(nId As Integer) As Integer
' ' Identificativo di ricerca nel grezzo
' Dim nFindId As Integer = GDB_ID.NULL
' ' Se pezzo non assegnato a gruppo
' If EgtIsPart(nId) Then
' ' Cerco associazione a gruppo in grezzo della prima fase di qualche gruppo di lavoro
' Dim sList As String = String.Empty
' If Not EgtGetInfo(nId, "!LST", sList) Then Return GDB_ID.NULL
' Dim sItems() As String = sList.Split(",".ToCharArray)
' If sItems.Count() = 0 Then Return GDB_ID.NULL
' For Each sLstId In sItems
' Dim nLstId As Integer = GDB_ID.NULL
' StringToInt(sLstId, nLstId)
' Dim nRawId = EgtGetParent(nLstId)
' Dim nPhase As Integer = 1
' EgtGetInfo(nRawId, "Ph", nPhase)
' If nPhase = 1 Then
' Dim sRawsName As String = String.Empty
' If EgtGetName(EgtGetParent(nRawId), sRawsName) AndAlso sRawsName = MACH_RAWS_GROUP Then
' nFindId = nLstId
' Exit For
' End If
' End If
' Next
' Else
' nFindId = nId
' End If
' ' Verifico identificativo di ricerca
' If nFindId = GDB_ID.NULL Then Return GDB_ID.NULL
' ' Il padre del padre deve essere il gruppo dei grezzi
' Dim nRawsId As Integer = EgtGetParent(EgtGetParent(nFindId))
' Dim sName As String = String.Empty
' If Not EgtGetName(nRawsId, sName) OrElse sName <> MACH_RAWS_GROUP Then Return GDB_ID.NULL
' ' Il padre del gruppo dei grezzi deve essere il gruppo di lavoro
' Dim nMachGrpId As Integer = EgtGetParent(nRawsId)
' Dim sMachGrpName As String = String.Empty
' If Not EgtGetMachGroupName(nMachGrpId, sMachGrpName) Then Return GDB_ID.NULL
' Return nMachGrpId
'End Function
' '--------------------------------------------------------------------------------------------------
' Public Sub HideParkedParts(Optional bDisableModified As Boolean = True)
' ' Se richiesto, disabilito impostazione modificato
' Dim bOldEnMod As Boolean = False
' If bDisableModified Then
' bOldEnMod = EgtGetEnableModified()
' If bOldEnMod Then EgtDisableModified()
' End If
' ' Nascondo pezzi parcheggiati
' Dim nPartId As Integer = EgtGetFirstPart()
' While nPartId <> GDB_ID.NULL
' EgtSetStatus(nPartId, GDB_ST.OFF)
' nPartId = EgtGetNextPart(nPartId)
' End While
' ' Se necessario, ripristino precedente impostazione modificato
' If bOldEnMod Then EgtEnableModified()
' End Sub
' Public Sub ShowParkedParts(Optional bDisableModified As Boolean = True)
' ' Se richiesto, disabilito impostazione modificato
' Dim bOldEnMod As Boolean = False
' If bDisableModified Then
' bOldEnMod = EgtGetEnableModified()
' If bOldEnMod Then EgtDisableModified()
' End If
' ' Visualizzo pezzi parcheggiati che non appartengano a grezzi di altri gruppi
' Dim nPartId As Integer = EgtGetFirstPart()
' While nPartId <> GDB_ID.NULL
' If PartIsFree(nPartId) Then
' EgtSetStatus(nPartId, GDB_ST.ON_)
' Else
' EgtSetStatus(nPartId, GDB_ST.OFF)
' End If
' nPartId = EgtGetNextPart(nPartId)
' End While
' ' Se necessario, ripristino precedente impostazione modificato
' If bOldEnMod Then EgtEnableModified()
' End Sub
' Public Function AdjustFlatPart(nPartId As Integer) As Boolean
' ' Ciclo sui layer
' Dim nLayerId As Integer = EgtGetFirstLayer(nPartId)
' While nLayerId <> GDB_ID.NULL
' ' Recupero il layer successivo
' Dim nNextLayerId As Integer = EgtGetNextLayer(nLayerId)
' ' Recupero il nome del layer
' Dim sLayName As String = String.Empty
' If EgtGetName(nLayerId, sLayName) Then
' ' Se layer OutLoop o InLoop
' If String.Compare(sLayName, NAME_OUTLOOP, True) = 0 Or
' String.Compare(sLayName, NAME_INLOOP, True) = 0 Then
' ' Sistemo i layer per applicare facilmente le lavorazioni
' EgtAdjustFlatPartLayer(nLayerId)
' End If
' ' Se senza nome, lo elimino
' Else
' EgtErase(nLayerId)
' End If
' ' Passo al layer successivo
' nLayerId = nNextLayerId
' End While
' Return True
' End Function
' Friend Function SetTextColor( nGroup As Integer) As Boolean
' ' Recupero il colore da assegnare ai testi
' Dim colText As New Color3d( 0, 0, 0)
' Dim sTextColor As String = " "
' If GetMainPrivateProfileString(S_NEST, K_TEXTCOLOR, " ", sTextColor) <> 0 Then
' Dim sTextColorArray() As String = sTextColor.Split(","c)
' Dim nRed As Integer = 0 : Integer.TryParse( sTextColorArray(0), nRed)
' Dim nGreen As Integer = 0 : Integer.TryParse( sTextColorArray(1), nGreen)
' Dim nBlue As Integer = 0 : Integer.TryParse( sTextColorArray(2), nBlue)
' colText.Setup( nRed, nGreen, nBlue)
' End If
' ' Assegno questo colore ai testi del layer indicato
' Dim nId As Integer = EgtGetFirstInGroup( nGroup)
' While nId <> GDB_ID.NULL
' If EgtGetType(nId) = GDB_TY.EXT_TEXT Then
' EgtSetColor(nId, colText)
' End If
' nId = EgtGetNext(nId)
' End While
' Return True
' End Function
' '--------------------------------------------------------------------------------------------------
' Public Function VerifyTrfData(nId As Integer) As Boolean
' ' Verifico se pezzo da Trf
' If Not EgtExistsInfo(nId, "OC") Then Return True
' ' Recupero e verifico lo spessore del pezzo
' Dim dTh As Double = 0
' EgtGetInfo(nId, "T", dTh)
' dim dTrfThickTolerance As double = GetMainPrivateProfileDouble(S_NEST, K_TRFTHICKTOLERANCE, 0.1)
' If Math.Abs(dTh - m_b3Raw.DimZ()) > dTrfThickTolerance Then Return False
' ' Recupero il materiale e la finitura superficiale del pezzo
' Dim sMat As String = ""
' EgtGetInfo(nId, "MT", sMat)
' Dim sSurf As String = ""
' EgtGetInfo(nId, "SRF", sSurf)
' ' Recupero materiale e finitura superficiale di pezzo già inserito (come dati di riferimento)
' Dim sRefMat As String = ""
' Dim sRefSurf As String = ""
' Dim nPartId As Integer = EgtGetFirstPartInRawPart(m_nRawId)
' While nPartId <> GDB_ID.NULL
' If EgtGetInfo(nPartId, "MT", sRefMat) And EgtGetInfo(nPartId, "SRF", sRefSurf) Then Exit While
' nPartId = EgtGetNextPartInRawPart(nPartId)
' End While
' If String.IsNullOrWhiteSpace(sRefMat) And String.IsNullOrWhiteSpace(sRefSurf) Then Return True
' ' Verifico materiale e finitura superficiale
' If sMat <> sRefMat Or sSurf <> sRefSurf Then Return False
' Return True
' End Function
' Public Function PreInsertOnePart(nId As Integer) As Boolean
' ' Se non esiste grezzo o pezzo non in parcheggio, esco
' If m_nRawId = GDB_ID.NULL OrElse Not EgtIsPart(nId) Then Return False
' ' Sistemazioni per eventuali lati inclinati con tallone
' AdjustPartSideAngleHeel(nId, m_b3Raw.DimZ())
' ' Sistemazioni per eventuali lati esterni inclinati e/o offsettati
' EgtCalcFlatPartUpRegion(nId, True)
' EgtCalcFlatPartDownRegion(nId, m_b3Raw.DimZ())
' ' Dimensioni del pezzo
' Dim b3Part As New BBox3d
' If Not EgtGetBBoxGlob(nId, GDB_BB.IGNORE_DIM + GDB_BB.IGNORE_TEXT, b3Part) Then Return False
' ' Centro del grezzo
' Dim ptRawCenter As Point3d
' If Not EgtGetRawPartCenter(m_nRawId, ptRawCenter) Then Return False
' Dim dRawCenX = ptRawCenter.x - m_b3Raw.Min().x
' Dim dRawCenY = ptRawCenter.y - m_b3Raw.Min().y
' ' Inserisco il pezzo nel grezzo, in centro in XY e in alto in Z
' Dim ptP As New Point3d(dRawCenX - 0.5 * b3Part.DimX(), dRawCenY - 0.5 * b3Part.DimY(), m_b3Raw.DimZ())
' If Not EgtAddPartToRawPart(nId, ptP, m_nRawId) Then Return False
' ' Aggiungo le lavorazioni standard
' Dim nWarn As Integer = 0
' AddMachinings(nId, nWarn)
' ' Lama troppo grande per utilizzo ventosa
' If nWarn = 1 Then OmagOFFICEMap.refStatusBarVM.SetOutputMessage(EgtMsg(MSG_SPLITPAGEUC + 11), 3, MSG_TYPE.WARNING)
' Return true
' End Function
' Public Function PreRemoveOnePart(nId As Integer) As Boolean
' ' Se non esiste il pezzo, esco
' If nId = GDB_ID.NULL Then Return false
' ' Rimuovo le lavorazioni
' EraseMachinings(nId)
' ' Elimino eventuali modifiche per lati esterni inclinati e/o offsettati
' EgtCalcFlatPartUpRegion(nId, False)
' EgtCalcFlatPartDownRegion(nId, 0)
' ' Eventuale cancellazione solido per taglio da sotto
' EraseSolidForDrip(nId)
' ' Parcheggio
' EgtRemovePartFromRawPart(nId)
' EgtSetStatus(nId, GDB_ST.ON_)
' Return true
' End Function
' Public Function InsertOnePart(nId As Integer, bAligned As Boolean, bReducedCut As Boolean) As Boolean
' ' Se il pezzo non è in parcheggio, non si può inserire
' If Not EgtIsPart(nId) Then Return False
' ' Metto pezzo in centro grezzo con lavorazioni e sistemazioni varie
' Dim bFit As Boolean = False
' If PreInsertOnePart( nId) Then
' ' Eseguo nesting
' If UpdateNestRegions() Then
' EnableReferenceRegion(bAligned)
' If Not EgtExistsInfo(m_nRawId, KEY_RAWBYPOINTS) Then
' bFit = EgtPackPartInRectangle(nId, bReducedCut, True)
' End If
' If Not bFit Then
' bFit = EgtPackPart(nId, bReducedCut, True)
' End If
' End If
' End If
' ' Gestione risultato nesting
' If bFit Then
' '---------------------- COUNTER PART ----------------------
' Dim sRefGroup As String = String.Empty
' If EgtGetInfo(nId, INFO_REFGROUP, sRefGroup) Then
' ' spengo il layer che contiene il contatore
' Dim nCounterLayer As Integer = EgtGetFirstNameInGroup(nId, INFO_COUNTERLY)
' EgtSetStatus(nCounterLayer, GDB_ST.OFF)
' ' aggiorno il layer che indica il numero di pezzi in parcheggio
' CountPartInFamily(sRefGroup)
' End If
' '---------------------- COUNTER PART ----------------------
' ' Eventuale aggiunta solido per taglio da sotto
' UpdateSolidForDrip(nId)
' Return True
' Else
' ' Ripristino lo stato originale
' PreRemoveOnePart( nId)
' Return False
' End If
' End Function
' Private Function AdjustPartSideAngleHeel(nPartId As Integer, dTh As Double) As Boolean
' ' Recupero entità del layer esterno e di quelli interni
' Dim vEnt As New List(Of Integer)
' Dim nEntId As Integer = EgtGetFirstInGroup(EgtGetFirstNameInGroup(nPartId, NAME_OUTLOOP))
' While nEntId <> GDB_ID.NULL
' vEnt.Add(nEntId)
' nEntId = EgtGetNext(nEntId)
' End While
' Dim nLayId As Integer = EgtGetFirstNameInGroup(nPartId, NAME_INLOOP)
' While nLayId <> GDB_ID.NULL
' nEntId = EgtGetFirstInGroup(nLayId)
' While nEntId <> GDB_ID.NULL
' vEnt.Add(nEntId)
' nEntId = EgtGetNext(nEntId)
' End While
' nLayId = EgtGetNextName(nLayId, NAME_INLOOP)
' End While
' ' Aggiorno le entità con tallone e quelle con angolo esterno
' Const AGG_DEPTH As Double = 2.0
' For Each nEnt As Integer In vEnt
' ' Se aggiornamento vietato, vado oltre
' If EgtExistsInfo( nEnt, INFO_SIDE_FIXED) Then continue for
' ' Recupero eventuali tallone ed angolo originale
' Dim dHeel As Double = 0
' Dim dSideAng As Double = 0
' EgtGetInfo(nEnt, INFO_HEEL, dHeel)
' EgtGetInfo(nEnt, INFO_ORIG_SIDE_ANGLE, dSideAng)
' If Math.Abs(dSideAng) > EPS_ANG_SMALL And dHeel > 10 * EPS_SMALL Then
' ' Angolo esterno
' If dSideAng > 0 Then
' ' Se tallone inferiore a spessore
' If dHeel < dTh - 10 * EPS_SMALL Then
' EgtSetInfo(nEnt, INFO_SIDE_ANGLE, 0.0)
' EgtSetInfo(nEnt, INFO_SIDE_ANGLE2, dSideAng)
' EgtSetInfo(nEnt, INFO_OFFSET2, -(dTh - dHeel) * Math.Tan(dSideAng * Math.PI / 180))
' EgtSetInfo(nEnt, INFO_DEPTH2, (dTh - dHeel) + AGG_DEPTH)
' ' altrimenti, tallone superiore a spessore -> non c'è taglio inclinato
' Else
' EgtSetInfo(nEnt, INFO_SIDE_ANGLE, 0.0)
' EgtSetInfo(nEnt, INFO_SIDE_ANGLE2, 0.0)
' EgtRemoveInfo(nEnt, INFO_OFFSET2)
' EgtRemoveInfo(nEnt, INFO_DEPTH2)
' End If
' ' Angolo interno
' Else
' ' Se tallone inferiore a spessore
' If dHeel < dTh - 10 * EPS_SMALL Then
' EgtSetInfo(nEnt, INFO_OFFSET, dHeel * Math.Tan(-dSideAng * Math.PI / 180))
' EgtSetInfo(nEnt, INFO_SIDE_ANGLE2, 0.0)
' EgtSetInfo(nEnt, INFO_DEPTH2, dHeel + AGG_DEPTH)
' ' altrimenti, tallone superiore a spessore -> non c'è taglio inclinato
' Else
' EgtSetInfo(nEnt, INFO_SIDE_ANGLE, 0.0)
' EgtRemoveInfo(nEnt, INFO_OFFSET)
' EgtRemoveInfo(nEnt, INFO_SIDE_ANGLE2)
' EgtRemoveInfo(nEnt, INFO_DEPTH2)
' End If
' End If
' ' Se altrimenti inclinazione esterna
' ElseIf dSideAng > EPS_ANG_SMALL Then
' EgtSetInfo(nEnt, INFO_OFFSET, -dTh * Math.Tan(dSideAng * Math.PI / 180))
' End If
' Next
' Return True
' End Function
'#Region "Manager Counter Part"
' ' lista delle famiglie di pezzi in parcheggio
' Public m_ListOfGroupInPark As New List(Of FamilyPart)
' ' se seleniozato il layer CounterPz
' Public m_bIsCounterLy As Boolean = False
' Public m_nCurrNubrOfParts As Integer = 0
' ' creo la lista delle famiglie che popolano il parcheggio
' Public Sub GetFamilyGroupInPark()
' m_ListOfGroupInPark.Clear()
' Dim nIdInPark As Integer = EgtGetFirstPart()
' While nIdInPark <> GDB_ID.NULL
' If IsInRaw(nIdInPark) Then
' nIdInPark = EgtGetNextPart(nIdInPark)
' Continue While
' End If
' Dim sRefGroup As String = String.Empty
' If EgtGetInfo(nIdInPark, INFO_REFGROUP, sRefGroup) Then
' Dim bExists As Boolean = False
' For Each sItem As FamilyPart In m_ListOfGroupInPark
' If sRefGroup = sItem.sRefGuid Then
' bExists = True
' Exit For
' End If
' Next
' If Not bExists Then
' m_ListOfGroupInPark.Add(New FamilyPart(sRefGroup, nIdInPark))
' End If
' End If
' nIdInPark = EgtGetNextPart(nIdInPark)
' End While
' End Sub
' Public Sub CountPartInFamily(sRefGuid As String)
' If String.IsNullOrEmpty(sRefGuid) Then Return
' Dim nCount As Integer = 0
' Dim nIdInPark As Integer = EgtGetFirstPart()
' ' conto il nuero di pezzi del gruppo inidcato
' While nIdInPark <> GDB_ID.NULL
' If IsInRaw(nIdInPark) Then
' nIdInPark = EgtGetNextPart(nIdInPark)
' Continue While
' End If
' Dim sRefGroup As String = String.Empty
' EgtGetInfo(nIdInPark, INFO_REFGROUP, sRefGroup)
' If sRefGroup = sRefGuid Then
' nCount += 1
' End If
' nIdInPark = EgtGetNextPart(nIdInPark)
' End While
' ' aggiorno il contatore dei pezzi del gruppo
' nIdInPark = EgtGetFirstPart()
' While nIdInPark <> GDB_ID.NULL
' If IsInRaw(nIdInPark) Then
' nIdInPark = EgtGetNextPart(nIdInPark)
' Continue While
' End If
' Dim sRefGroup As String = String.Empty
' EgtGetInfo(nIdInPark, INFO_REFGROUP, sRefGroup)
' If sRefGroup = sRefGuid Then
' Dim nId As Integer = EgtGetFirstNameInGroup(nIdInPark, INFO_COUNTERLY)
' If nId <> GDB_ID.NULL Then
' Dim m_IdCounterTextas As Integer = EgtGetFirstInGroup(nId)
' EgtModifyText(m_IdCounterTextas, "# " & nCount.ToString)
' End If
' End If
' nIdInPark = EgtGetNextPart(nIdInPark)
' End While
' End Sub
' Public Sub SelectPartInFaimily(sRefGuid As String, nNbrOfSelection As Integer)
' ' aggiorno il contatore dei pezzi del gruppo
' Dim nIdInPark As Integer = EgtGetFirstPart()
' Dim nCounter As Integer = 0
' While nIdInPark <> GDB_ID.NULL And nCounter < nNbrOfSelection
' If IsInRaw(nIdInPark) Then
' nIdInPark = EgtGetNextPart(nIdInPark)
' Continue While
' End If
' Dim sRefGroup As String = String.Empty
' EgtGetInfo(nIdInPark, INFO_REFGROUP, sRefGroup)
' If sRefGroup = sRefGuid Then
' EgtSelectObj(nIdInPark)
' nCounter += 1
' End If
' nIdInPark = EgtGetNextPart(nIdInPark)
' End While
' End Sub
' Public Sub DeselectPartInFaimily(sRefGuid As String)
' ' aggiorno il contatore dei pezzi del gruppo
' Dim nIdInPark As Integer = EgtGetFirstPart()
' While nIdInPark <> GDB_ID.NULL
' If IsInRaw(nIdInPark) Then
' nIdInPark = EgtGetNextPart(nIdInPark)
' Continue While
' End If
' Dim sRefGroup As String = String.Empty
' EgtGetInfo(nIdInPark, INFO_REFGROUP, sRefGroup)
' If sRefGroup = sRefGuid Then
' EgtDeselectObj(nIdInPark)
' End If
' nIdInPark = EgtGetNextPart(nIdInPark)
' End While
' End Sub
' Public Function ParkInGroupFamily(nId As Integer) As Boolean
' ' se pezzo appartenente ad un gruppo
' Dim sRefGroup As String = String.Empty
' Dim Element As FamilyPart
' If EgtGetInfo(nId, INFO_REFGROUP, sRefGroup) Then
' ' verifico se esiste un pezzo dello stesso gruppo in parcheggio
' Dim nNewLayer As Integer
' Dim ptMin As Point3d
' Dim ptMax As Point3d
' For Each sItem As FamilyPart In m_ListOfGroupInPark
' If sRefGroup = sItem.sRefGuid Then
' ' creo un nuovo layer per contenere l'informazione del numero di pezzi da inserire
' If EgtGetFirstNameInGroup(nId, INFO_COUNTERLY) = GDB_ID.NULL Then
' nNewLayer = EgtCreateGroup(nId)
' EgtSetName(nNewLayer, INFO_COUNTERLY)
' EgtSetColor(nNewLayer, New Color3d(0, 0, 0))
' EgtGetBBox(nId, GDB_BB.STANDARD, ptMin, ptMax)
' EgtCreateText(nNewLayer, New Point3d((ptMin.x + ptMax.x) / 2, ptMin.y - sItem.nHText - 20, ptMin.z), "# ???", sItem.nHText, GDB_RT.LOC)
' Else
' ' Accendo il layer che contiene il contatore
' Dim nCounterLayer As Integer = EgtGetFirstNameInGroup(nId, INFO_COUNTERLY)
' EgtSetStatus(nCounterLayer, GDB_ST.ON_)
' End If
' ' calcolo lo spostamento del pezzo
' Dim PtMinInRaw As Point3d
' Dim PtMaxInRaw As Point3d
' EgtGetBBoxGlob(nId, GDB_BB.STANDARD, PtMinInRaw, PtMaxInRaw)
' Dim vtMoveToStorage As New Vector3d
' vtMoveToStorage = sItem.PtStorage() - PtMinInRaw
' EgtMove(nId, vtMoveToStorage, GDB_RT.GLOB)
' ' aggiorno il layer che indica il numero di pezzi in parcheggio
' CountPartInFamily(sRefGroup)
' Return True
' End If
' Next
' ' inserisco il primo pezzo del gruppo nel parcheggio
' Element = New FamilyPart(sRefGroup, nId)
' m_ListOfGroupInPark.Add(Element)
' ' creo un nuovo layer per contenere l'informazione del numero di pezzi da inserire
' If EgtGetFirstNameInGroup(nId, INFO_COUNTERLY) = GDB_ID.NULL Then
' nNewLayer = EgtCreateGroup(nId)
' EgtSetName(nNewLayer, INFO_COUNTERLY)
' EgtSetColor(nNewLayer, New Color3d(0, 0, 0))
' EgtGetBBox(nId, GDB_BB.STANDARD, ptMin, ptMax)
' ' posso migliorarei lposizioanamento in funzione della dimensione della scritta...
' EgtCreateText(nNewLayer, New Point3d((ptMin.x + ptMax.x) / 2, ptMin.y - Element.nHText - 20, ptMin.z), "# 1", Element.nHText, GDB_RT.LOC)
' Else
' ' Accendo il layer che contiene il contatore
' Dim nCounterLayer As Integer = EgtGetFirstNameInGroup(nId, INFO_COUNTERLY)
' EgtSetStatus(nCounterLayer, GDB_ST.ON_)
' ' aggiorno il layer che indica il numero di pezzi in parcheggio
' CountPartInFamily(sRefGroup)
' End If
' End If
' Return False
' End Function
' ' verifico se il pezzo ha un gruppo che contiene le informazioni per il taglio
' Public Function IsInRaw(nIdGroup As Integer) As Boolean
' ' verifico che il pezzo sia veramente uin parcheggio
' Dim nPV As Integer = EgtGetFirstNameInGroup(nIdGroup, "PV")
' If nPV <> GDB_ID.NULL Then
' ' verifico che non ci siano delle lavorazioni
' If EgtGetFirstInGroup(nPV) <> GDB_ID.NULL Then
' Return True
' End If
' End If
' Return False
' End Function
'#End Region ' Manager Counter Part
' Public Function StoreOnePart(ByVal nId As Integer, Optional ByVal bForced As Boolean = False) As Boolean
' ' Se pezzo in grezzo, metto in parcheggio (sempre possibile)
' If bForced OrElse
' (m_nRawId <> GDB_ID.NULL AndAlso EgtGetParent(nId) = m_nRawId) Then
' ' Ripristino lo stato originale
' PreRemoveOnePart(nId)
' '---------------------- COUNTER PART ----------------------
' ' se esiste almento un pezzo del gruppo in parcheggio esco
' If ParkInGroupFamily(nId) Then Return True
' '---------------------- COUNTER PART ----------------------
' ' Parcheggio
' PackPartInStore(nId)
' ' Aggiusto la posizione in Z
' Dim ptPartMin, ptPartMax As Point3d
' If EgtGetBBoxGlob(nId, GDB_BB.IGNORE_DIM + GDB_BB.IGNORE_TEXT, ptPartMin, ptPartMax) And m_nRawId <> GDB_ID.NULL Then
' EgtMove(nId, New Vector3d(0, 0, m_b3Raw.Max().z - ptPartMax.z), GDB_RT.GLOB)
' End If
' Return True
' End If
' Return False
' End Function
' Public Function PackPartInStore(nId As Integer) As Boolean
' ' Recupero box tavola
' Dim b3Tab As New BBox3d
' If Not EgtGetTableArea(1, b3Tab) Then
' b3Tab.Add(New Point3d(0, 0, 0))
' b3Tab.Add(New Point3d(-3600, -2600, 0))
' End If
' ' Parcheggio
' Const STORE_LARGH As Double = 6000
' Const STORE_DIST As Double = 200
' ' 40 il Font usato per indicare il numero di pezzi in parcheggio "# N"
' Const STORE_OFFS As Double = 20 + 40 + 20
' Dim dStXmin As Double = b3Tab.Min().x - 0.5 * (STORE_LARGH - b3Tab.DimX())
' Return EgtPackBox(nId, dStXmin, -INFINITO, dStXmin + STORE_LARGH, b3Tab.Min().y - STORE_DIST, STORE_OFFS, False)
' End Function
' Friend Function VerifyPartsNesting(bReducedCut As Boolean) As Boolean
' ' Aggiorno regioni per nesting
' UpdateNestRegions()
' EnableReferenceRegion(False)
' ' Ciclo su tutti i pezzi in tavola
' Dim nPartId As Integer = EgtGetFirstGroupInGroup(m_nRawId)
' While nPartId <> GDB_ID.NULL
' If Not EgtVerifyPart(nPartId, bReducedCut) Then
' Return False
' End If
' nPartId = EgtGetNextGroup(nPartId)
' End While
' Return True
' End Function
' Friend Function StoreCollisionParts(bReducedCut As Boolean) As Boolean
' ' Aggiorno regioni per nesting
' UpdateNestRegions()
' EnableReferenceRegion(False)
' ' Ciclo su tutti i pezzi in tavola (dall'ultimo)
' Dim nPartId As Integer = EgtGetLastGroupInGroup(m_nRawId)
' While nPartId <> GDB_ID.NULL
' Dim nPrevPartId As Integer = EgtGetPrevGroup(nPartId)
' If Not EgtVerifyPart(nPartId, bReducedCut) Then
' StoreOnePart(nPartId, True)
' End If
' nPartId = nPrevPartId
' End While
' Return True
' End Function
' Public Function UpdateNestRegions() As Boolean
' ' Se necessario, creo la regione fuori kerf
' Dim nKerfId As Integer = EgtGetFirstNameInGroup(GetRawId(), NAME_KERF)
' EgtCreateOutRegion(GetRawId(), nKerfId)
' ' Se necessario, creo la regione di riferimento
' EgtCreateReferenceRegion(GetRawId(), nKerfId, True)
' ' Se necessario, creo le regioni per le aree danneggiate
' Dim nId As Integer = EgtGetFirstNameInGroup(GetRawId(), NAME_DAMAGED)
' While nId <> GDB_ID.NULL
' EgtCreateDamagedRegion(GetRawId(), nId)
' nId = EgtGetNextName(nId, NAME_DAMAGED)
' End While
' Return True
' End Function
' Public Function EnableReferenceRegion(bEnable As Boolean) As Boolean
' ' Recupero identificativo della regione di riferimento
' Dim nRegId As Integer = EgtGetFirstNameInGroup(GetRawId(), NAME_REF_REG)
' If nRegId = GDB_ID.NULL Then Return False
' ' Imposto l'abilitazione voluta
' If bEnable Then
' EgtRemoveInfo(nRegId, KEY_REF_REG_OFF)
' Else
' EgtSetInfo(nRegId, KEY_REF_REG_OFF, 1)
' End If
' Return True
' End Function
' Public Function AddTopToPartRegion( nRegId As Integer) As Boolean
' Dim frReg As New Frame3d : EgtGetGroupGlobFrame( nRegId, frReg)
' Dim b3Reg As New BBox3d : EgtGetBBoxGlob( nRegId, GDB_BB.STANDARD, b3Reg)
' Dim dH As Double = Math.Min(0.1 * b3Reg.DimY(), 30)
' Dim ptIns As New Point3d( b3Reg.Center().x, b3Reg.Max().y - dH, b3Reg.Max().z)
' ptIns.ToLoc( frReg)
' Dim nSfrId As Integer = EgtGetFirstInGroup( nRegId)
' While nSfrId <> GDB_ID.NULL
' If EgtGetType( nSfrId) = GDB_TY.SRF_FRGN Then Exit While
' nSfrId = EgtGetNext( nSfrId)
' End While
' If nSfrId <> GDB_ID.NULL Then
' Dim ptStart As New Point3d ( b3Reg.Min().x, b3Reg.Max().y - dH, b3Reg.Max().z)
' ptStart.ToLoc( frReg)
' Dim ptEnd As New Point3d ( b3Reg.Max().x, b3Reg.Max().y - dH, b3Reg.Max().z)
' ptEnd.ToLoc( frReg)
' Dim nLineId As Integer = EgtCreateLine( nRegId, ptStart, ptEnd)
' Dim nCount As Integer = 0
' Dim nNewId As Integer = EgtTrimCurveWithRegion( nLineId, nSfrId, True, False, nCount)
' If nNewId <> GDB_ID.NULL Then
' If nCount > 0 Then EgtMidPoint( nNewId, ptIns)
' For nTmpId As Integer = nNewId To nNewId + nCount - 1
' EgtErase( nTmpId)
' Next
' Else
' EgtErase( nLineId)
' End If
' End If
' Dim vtDir As New Vector3d( 1, 0, 0)
' vtDir.ToLoc( frReg)
' Dim dLen, dAngV, dAngH As Double
' vtDir.ToSpherical( dLen, dAngV, dAngH)
' Dim nText As Integer = EgtCreateTextAdv(nRegId, ptIns, dAngH, "*TOP*", "", 500, False, dH, 1, 0, INS_POS.MC)
' Return ( nText <> GDB_ID.NULL)
' End Function
#End Region ' Methods
End Module
Reference in New Issue View Git Blame Copy Permalink