Egalware/OmagVIEWPlus
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
OmagVIEWPlus/EgtStoneLib/EstCalc.vb
T
Nicola Pievani d950fc1060 OmagVIEWPlus 2.2j1: 
-> nuova definizione dei pezzi (classe Part)
-> nuova gestione dei magazzini
-> aggiunta pagina per la selezione dei pezzi manuali
-> nuova configurazione delle variabili.
2020-10-09 08:13:48 +00:00

790 lines
33 KiB
VB.net
Raw Permalink Blame History

Imports System.Globalization
Imports EgtUILib
Imports EgtWPFLib5
Module EstCalc
'--------------------------------------------------------------------------------------------------
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
'--------------------------------------------------------------------------------------------------
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
' 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 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)
'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)
'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)
'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)
'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)
'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 esiste sovratavola, esco subito
' If dAddTable < 10 * EPS_SMALL Then Return True
' ' Recupero box tavola
' Dim ptMin, ptMax As Point3d
' EgtGetTableArea(1, ptMin, ptMax)
' ' Aggiungo sovratavola nel gruppo dei bloccaggi
' ptMax.z -= DELTAZ_ADDTAB
' ptMin.z = ptMax.z
' ptMax.z += dAddTable
' Dim nAddTabId As Integer = EgtCreateSurfTmBBox(nFixtId, ptMin, ptMax, GDB_RT.GLOB)
' 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
' ' 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
'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)
' ' 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
' Const STORE_OFFS As Double = 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, 0)
' 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, 0)
' ptStart.ToLoc( frReg)
' Dim ptEnd As New Point3d ( b3Reg.Max().x, b3Reg.Max().y - dH, 0)
' 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 Module
Reference in New Issue View Git Blame Copy Permalink