Afspraken i.v.m. Posities van Beslag en Boringen:
  • Standaard zijn posities STEEDS gemeten van Links (X), van Boven (Y) en vanaf de Rug (Z)
  • AfstandRand is steeds relatief (t.o.v. de buitenrand van het profiel)
  • Negatieve posities zijn gemeten van de tegenovergestelde kant:
    | PosX < 0 ==> X = KD.Breedte - PosX
    | PosY < 0 ==> Y = KD.Hoogte - PosY
    | PosZ < 0 ==> Z = KD.ProfType.Dikte - PosZ
  • De negatieve posities zijn
    - te tonen als positieve waarden in de User Interface
    - op te slaan in Caché als negatieve waarden
    - in XML eveneens als negatieve waarden op te slaan met ev. een Attribute "omschrijving", bvb. "OMS=Van onderkant"
]]>
serial %Library.SerialObject,VHSys.Library %Library.Float %Library.Float Volgende waarden moeten gebruikt worden:
  • 0 : PuntBoring
  • -1 : Doorboring
  • 1 : Default Diepte]]> %Library.Float Alleen te gebruiken indien er in het glas en in het kader wordt geboord voor de "glas"-profielen. Deze is nodig omdat de boring in glas dan verschillend is van de profielboring. De BoorGlasDiameter is standaard 9mm %Library.Float PL - PR - PB - PO - VUL - P?;VUL
    Kader - id - id - id - Vulling - Kader&Vulling; Is enkel ingevuld in het geval van een "geldige boring".]]>
    %Library.String
    Tijdelijk de validatie uitgeschakeld om ook 'multi-value' data toe te laten (data uit wizard kan bvb. ook "PB;VUL" zijn. By WimV on 03/01/2012 1 %Status Dit is de nieuwe datastructuur sinds 14/03/2001 %Library.String Als "Niet Automatisch Frezen" gekozen, dan is het eerste character een "!"]]> %Library.String %String [Maatwerk Framework : GUI kenmerk] %Library.String [Maatwerk Framework : GUI kenmerk] %Library.String [Maatwerk Framework : GUI kenmerk] %Library.String Bevat de code voor TxtOpmerking. Transient. TxtOpmKode wordt samen met TxtOpmerking opgevuld door de method TxtOpmerkingSet %Library.String 1 %Library.String 1 %Library.String 1 %Library.String %Library.Float %Library.Float %Library.Float Berekent de Absolute Positie voor de gegeven coördinaat (X, Y, Z) uitgaande van de relatieve positie. Als relatieve positie leeg is, of als blnAbsOnly=1 , dan wordt de gewone (absolute) Pos teruggegeven. OPM: "Next" en "Previous" zijn hier niet mogelijk. sCode:%Library.String,KadObj:Prod.GADef.KaderDeur,blnAbsOnly:%Library.String=0 %Library.Float 0 Do . Set AbsPos=RelIPos Else If (RelIPos'="") Do . Set AbsPos=KadObj.AbsPosCalc(sCode,RelIPos) . Set:(AbsPos=RelIPos) AbsPos="" Set:($G(AbsPos)="") AbsPos=IPos Quit AbsPos ]]> Als blnOpposite=1, dan geeft CalcHoogtePos steeds de dikte/breedte (voor onder+boven/interne+externe zijde).]]> GADefProd:Prod.GADef.KaderDeur,blnOpposite:%Library.Integer=1 %Library.Float GADefProd:Prod.GADef.KaderDeur %Library.Float GADefProd:Prod.GADef.KaderDeur %Library.Float Returns "" (empty string) if OK.
    Mogelijke waarschuwingen zijn:
  • Boring in Vrije zone Verbinder
  • Boring in profiel van Scharnierzijde.]]> KadObj:Prod.GADef.KaderDeur %Library.String 0)&(%this.AfschuinDiameter>%this.BoorDiameter) D2=%this.AfschuinDiameter/2 . ; Transformatie naar eerste kwadrant . Set:((2*pX)>KadObj.Breedte) pX=KadObj.Breedte-pX . Set:((2*pY)>KadObj.Hoogte) pY=KadObj.Hoogte-pY . ; Take BoorDiameter into account . Set pX=pX-D2 . Set pY=pY-D2 . ; Get Vrijze Zone verbinder . Set HoekL=KadObj.ProfType.Hoek.ConstructAfm.GetAt("VRZBOR") . Set HoekB=KadObj.ProfType.Hoek.ConstructAfm.GetAt("BORAX") ; "VRZBORB" . ; Controle Vrije Zone . If ((pX Voor een D=5;7 doorboring wordt automatisch CncID="HULS" en AD=6.5, behalve als CncID="BOR".
    Info wordt weggeschreven in de property ]]>
    Breedte:%Library.Float,Hoogte:%Library.Float,ProfType:Res.PI.ProfType,VullingObj:Prod.GADef.emKadVulling,KadObj:Prod.GADef.KaderDeur %Library.Boolean 0)&(%this.AfschuinDiameter>%this.BoorDiameter) D2=%this.AfschuinDiameter/2 ; Transformatie naar eerste kwadrant Set:((2*pX)>Breedte) pX=Breedte-pX Set:((2*pY)>Hoogte) pY=Hoogte-pY If (%this.BoringType="ON")!(%this.BoringType="BO") Do ; Laterale boring . ; Diameter ligt volledig binnen de Kaderdeur ? . Set:(pX-D2'>0) msg="Rand Kader" . Set:(pY-D2'>0) msg="Rand Kader" . Quit:(msg'="") . ; . ; Boring beslist welke punten (posities) in het profiel moet gecontroleerd worden . Set Pos1D=$S(pX"" of CncID="BOR" ... Set %this.CncID="HULS" ... Set %this.AfschuinDiameter=6.5 . If %this.CncID["HULS", ((%this.BoringType'="ON")!(%this.BoorDiameter'=5)!(%this.BoorDiepte'<0)) Do .. ; Reset/Remove "HULS" indien niet meer van toepassing .. Set %this.CncID="" .. Set:(%this.AfschuinDiameter=6.5) %this.AfschuinDiameter="" . ; . ; Controle Vulling . If (%this.BoorDiepte=-1) Quit:($$cbgControleVulling(.msg,VullingObj)=0) ; Doorboring NIET mogelijk ? --> Quit . Else Set:(msg="OK: VUL") msg="Rugboring in Glas" ; Rugboring in glas NIET mogelijk . ; . Quit:($E(msg,1,3)'="OK:") ; Set msg="Fout Boring" . Set OK=1 Else If (%this.BoringType="IN")!(%this.BoringType="EX") Do ; Dwarse (zij)boring . ; Diameter ligt op de rand van de Kaderdeur ? . Set:(%this.BoringType="EX") ProfPos=0 . Set:(%this.BoringType="IN") ProfPos=ProfType.Breedte . ; . Set:(pX-ProfPos\1=0)&(pY-ProfPos\1=0) msg="Fout Rand" . Set:(pX-ProfPos\1<0)!(pY-ProfPos\1<0) msg="Niet op Rand" . Set:(pX-ProfPos\1'=0)&(pY-ProfPos\1'=0) msg="Niet op Rand" . Quit:(msg'="") . ; . Set Pos1D=%this.ZPos . Set msg=$$cbgTestBoring1D(ProfType,%this.BoringType,Pos1D,D2,%this.BoorDiepte) . Quit:($E(msg,1,3)'="OK:") . ; . Set OK=1 Else Do . ; Type boring onbekend . Set OK=0 . Quit Do %this.OpmerkingKodeSet(msg,"NL") Quit OK cbgTestBoring1D(ProfielType,Kant,Pos1D,Straal,Diepte) New TypePlus,TypeMin Set TypePlus=ProfielType.PuntInfoGet(Kant,Pos1D+Straal,Diepte) Set TypeMin=ProfielType.PuntInfoGet(Kant,Pos1D-Straal,Diepte) ;Set %this.Opmerking="Test: TP="_TypePlus_" , TM="_TypeMin_" , P+S="_(Pos1D+Straal)_" , P-S="_(Pos1D-Straal) Quit:(TypePlus'=TypeMin) "Fout Boring" Quit TypePlus cbgControleVulling(msg,VullingObj) ; msg should be passed by reference ! New vOK,ResultB If msg'["VUL" Set vOK=1 Else Do . Set ResultB=VullingObj.ControleBoring($E(msg,4,999)) . If (ResultB'="OK:"),(ResultB'="") Do .. ; Fout bij boring in de vulling: foutmelding via teruggeven. .. Set msg=ResultB .. Set vOK=0 . Else Set vOK=1 . ; Quit vOK ]]>
    ]]> MaxX:%Library.Float,MaxY:%Library.Float,MaxZ:%Library.Float,MaxD:%Library.Float %Library.String 0)!(%this.XPos'0)!(%this.YPos'0),%this.BoorDiameter'="",(%this.BoorDiameter'>0)!(%this.BoorDiameter'0)!(%this.AfschuinDiameter'0,%this.BoorDiameter>0,(%this.AfschuinDiameter'>%this.BoorDiameter) Set msg="A" ; AfschuinD is kleiner dan BoorDiameter . Else If %this.BoorGlasDiameter'="",(%this.BoorGlasDiameter<5) Set msg="BGD" . Else If (%this.XPos="")&(%this.YPos="")&(%this.BoorDiameter="") Set msg="Leeg" . Else If (%this.XPos="")!(%this.YPos="")!(%this.BoorDiameter="") Set msg="Onvolledig" . ;Else If (%this.XPos="")!(%this.YPos="")!(%this.BoorDiameter="")!((%this.BoringPlaats="KG")&(%this.BoorGlasDiameter="")) Set msg="Onvolledig" . Else Set OK=1 Else IF (%this.BoringType="EX")!(%this.BoringType="IN") Do . ; Zijboring . If %this.XPos'="",(%this.XPos<0)!(%this.XPos>MaxX) Set msg="X" . Else If %this.YPos'="",(%this.YPos<0)!(%this.YPos>MaxY) Set msg="Y" . Else If %this.ZPos'="",(%this.ZPos'>0)!(%this.ZPos'0)!(%this.BoorDiameter'0),%this.BoorDiameter'="",(%this.BoorDiameter'>0)!(%this.BoorDiameter'0)!(%this.AfschuinDiameter'%this.BoorDiameter) Set msg="A" ; AfschuinD is kleiner dan BoorDiameter . Else If (%this.XPos="")&(%this.YPos="")&(%this.ZPos="")&(%this.BoorDiameter="") Set msg="Leeg" . Else If (%this.XPos="")!(%this.YPos="")!(%this.ZPos="")!(%this.BoorDiameter="") Set msg="Onvolledig" . Else Set OK=1 . ; Else Do . ; Type boring onbekend . Set OK=0 . Quit Do:(OK'=1) %this.OpmerkingKodeSet(msg,"NL") Quit OK ]]> Copy maken van een boring in een nieuw object. Verschillende CopyModes: "FullCopy" (=Default), "BorNormal", "Empty" CopyMode:%Library.String="FullCopy" Prod.GADef.emKadBoring Geeft True of False terug, naargelang de boring een speciale of een gewone is. %Library.Boolean 0) Quit 0 ; boring is een "HULS" doorboring If %this.BoorDiepte<0, %this.BoorDiameter=5, %this.AfschuinDiameter=6.5, %this.BoorGlasDiameter>5, $E(%this.CncID,1,4)="HULS" Quit 0 ; boring is een normale doorboring If %this.BoorDiepte<0, ('%this.BoorDiameter)!(%this.BoorDiameter>0), %this.AfschuinDiameter'>0, ('%this.BoorGlasDiameter)!(%this.BoorGlasDiameter=7) Quit 0 ; boring is een normale rugboring If %this.BoorDiepte>0, ('%this.BoorDiameter)!(%this.BoorDiameter>0), %this.AfschuinDiameter'>0, ('%this.BoorGlasDiameter)!(%this.BoorGlasDiameter=7) Quit 0 Quit 1 ]]> QtyStaffel:%Library.Integer,MuntPar:%Library.Float,DtlObj:Res.PI.emKostDetail,Opties:%Library.String,Omtrek:%Library.Float,Opp:%Library.Float,Volume:%Library.Float %Library.Float Kode:%Library.String,Taal:%Library.String="NL" Creëert een tekstlijn op basis van de gegevens van het Embedded Boring Object. Deze Tekst wordt tijdelijk opgeslagen in de property TxtSpecial (Transient). Taal:%Library.String="NL" %Library.String Tekenen van de VML-boringen binnen de groep van alle beslag. Voor iedere boring van het beslag wordt deze routine telkens opgeroepen. DevObj:%Library.String,Plaats:%Library.String,ProfBreedte:%Library.Float,TekeningCode:%Library.String,Opties:%Library.String " ; "" New BType,strVML,OriginX,OriginY,intSize,intRotate,strColor,TekCode Set BType=$S((%this.BoringType="EX")!(%this.BoringType="IN"):"Z", 1:%this.BoringType) If BType="Z",$G(Plaats)="" Quit Set TekCode=$G(TekeningCode,"") Set OriginX=%this.XPos Set OriginY=%this.YPos Set intSize=$S(%this.BoorDiameter<0:0, 1:%this.BoorDiameter) Set intRotate=$S(Plaats="PL":0, Plaats="PB":90, Plaats="PR":180, Plaats="PO":270, 1:0) ; Externe boring Set strColor="blue" ; Select VML type for this boring If $L(%this.VmlID)>2 Do ; Special VML-code . Set strVML="" . ;Quit:(BType="Z") ; Skip drawing when frezing is on "Z(ijkant)" . Set strVML=$$VMLShape^VHSys.Library.VMLLib(%this.VmlID,OriginX,OriginY,intSize,intRotate,strColor,)_NL Else If BType="Z" Do ; ZIJ BORING ("T") . Set intSize=14 ; Fixed size for "Zijboring" . Set:(%this.BoringType="IN") intRotate=(intRotate+180)#360 . Set strColor="red" . Set strVML=$$TCross^VHSys.Library.VMLLib(OriginX,OriginY,intSize,intSize,strColor,intRotate,)_NL Else If %this.IsSpecialeBoring() Do ; SPECIALE BORING ("+") . Set intSize=10 . Set strVML=$$CrossHV^VHSys.Library.VMLLib(OriginX,OriginY,intSize,intSize,strColor,)_NL Else If %this.BoorDiepte<0 Do ; DOORBORING ("o") . Set strVML=$$Circle^VHSys.Library.VMLLib(OriginX,OriginY, $S(intSize<2:2, 1:intSize), strColor,strColor,)_NL Else If (%this.BoorDiameter<0)||(%this.BoorDiepte=0) Do ; PUNT BORING ("X") . Set intSize=10 . Set strVML=$$CrossDiag^VHSys.Library.VMLLib(OriginX,OriginY,intSize,intSize,strColor,)_NL Else Do ; STD RUGBORING ("o"&"X") . Set strVML="" . Set:(intSize'>10) strVML=$$CrossDiag^VHSys.Library.VMLLib(OriginX,OriginY,10,10,strColor,)_NL . Set strVML=strVML_$$Circle^VHSys.Library.VMLLib(OriginX,OriginY, $S(intSize<2:2, 1:intSize), strColor,strColor,)_NL . ; ; Add VML boring to DevObj Do WRITE^XMLWRITE(.DevObj,strVML) Quit ]]> Voor een zijboring ("Z") is [objParent] of ( [Plaats] en [ProfBreedte]) verplicht door te geven.]]> ; ... ; New BType,strVML,strVML2,intLeft,intTop,intSize,intRotate,strColor,FKey New sProf,Opposite,NL Set NL=$C(13)_$C(10) Set BType=$S((%this.BoringType="EX")!(%this.BoringType="IN"):"Z", 1:%this.BoringType) If BType="Z",$G(Plaats)="",'$G(objParent) Quit Set:($G(Plaats)="") Plaats=objParent.ProfielPlaatsGet(%this) Quit:(objParent.NietOpProfiel(Plaats)) ; Prepare Boring Symbol ; --------------------- Set strVML="" Set strColor="black" If BType="Z" Do . ; Zijboring . ;Set:($G(Plaats)="") Plaats=objParent.ProfielPlaatsGet(%this) . Set intRotate=$S(Plaats="PL":0, Plaats="PB":90, Plaats="PR":180, Plaats="PO":270, 1:0) ; Externe boring . Set:(%this.BoringType="IN") intRotate=(intRotate+180)#360 . Set strColor="red" . Set strVML=$$TCross^VHSys.Library.VMLLib(50,50,50,50,strColor,intRotate,)_NL . ; Values for . Set intSize=14*2 Else If %this.IsSpecialeBoring() Do . ; Speciale boring: put (+) sign to draw users attention . Set strVML=$$CrossHV^VHSys.Library.VMLLib(50,50,100,100,strColor,)_NL . ; Values for . Set intSize=12 Else If %this.BoorDiepte<0 Do . ; Doorboring (normal circle) . Set strVML=$$Circle^VHSys.Library.VMLLib(50,50,100,strColor,)_NL . ; Values for . Set intSize=$S(%this.BoorDiameter<2:2, 1:%this.BoorDiameter) Else If (%this.BoorDiameter<0)||(%this.BoorDiepte=0) Do . ; Puntboring (X : diagonal cross) . Set strVML=$$CrossDiag^VHSys.Library.VMLLib(50,50,100,100,strColor,)_NL . ; Values for . Set intSize=10 Else Do . ; Standaard Rugboring ( . Set strVML=$$CrossDiag^VHSys.Library.VMLLib(50,50,100,100,strColor,)_NL . Set strVML=strVML_$$Circle^VHSys.Library.VMLLib(50,50,$S(%this.BoorDiameter<2:2, 1:%this.BoorDiameter)*10,strColor,)_NL . ; Values for . Set intSize=10 Set intLeft=%this.XPos-(intSize\2) Set intTop=%this.YPos-(intSize\2) ; Set VML Group and surrounding rectangle Set strVML2="" If $G(Opties)["C" Set strVML2=strVML2_""_NL Set strVML2=strVML2_$$xvwVMLGroepOpen(intLeft,intTop, intSize,intSize)_NL Set strVML2=strVML2_strVML Set strVML2=strVML2_$$xvwVMLGroepClose()_NL Do WRITE^XMLWRITE(DevObj,strVML2) ; !!! DOORBORING in zijkant - draw OPPOSITE zijboring !!! If (BType="Z"),(%this.BoorDiepte<0) Do . Set strVML=$$TCross^VHSys.Library.VMLLib(50,50,50,50,strColor,(intRotate+180)#360,)_NL . Set sProf=%this.BoringType_"-"_Plaats . Set:($G(ProfBreedte)="") ProfBreedte=objParent.ProfType.Breedte . Set Opposite=ProfBreedte*$S((sProf="IN-PL")!(sProf="IN-PB")!(sProf="EX-PR")!(sProf="EX-PO"):-1,(sProf="EX-PL")!(sProf="EX-PB")!(sProf="IN-PR")!(sProf="IN-PO"):1,1:0) . Set:(Plaats="PL")!(Plaats="PR") intLeft=intLeft+Opposite . Set:(Plaats="PB")!(Plaats="PO") intTop=intTop+Opposite . Set strVML2="" . Set strVML2=strVML2_$$xvwVMLGroepOpen(intLeft,intTop, intSize,intSize)_NL . Set strVML2=strVML2_strVML . Set strVML2=strVML2_$$xvwVMLGroepClose()_NL . Do WRITE^XMLWRITE(DevObj,strVML2) Quit xvwVMLGroepOpen(Left,Top,Width,Height) Set:(Width\1'>0) Width=1 Set:(Height\1'>0) Height=1 Quit "" xvwVMLGroepClose() Quit "" ]]> 0 Do ; Punten van boring . Do:(%this.BoorDiameter) TAGWRITE^XMLWRITE(DevObj,"DIAMETER",%this.BoorDiameter,"UNIT=""mm""") . Do:(%this.BoorGlasDiameter) TAGWRITE^XMLWRITE(DevObj,"GLASDIAMETER",%this.BoorGlasDiameter,"UNIT=""mm""") . Do:(%this.AfschuinDiameter) TAGWRITE^XMLWRITE(DevObj,"AFSCHUINDIAMETER",%this.AfschuinDiameter,"UNIT=""mm""") Else Do ; Puntboring . Do:(%this.BoorDiameter'="") TAGWRITE^XMLWRITE(DevObj,"DIAMETER","punt","") ; Plaatsbepaling If %this.BoringType="ON" Do ;Standaard boring langs ONder . Set Param=$S(%this.BoorDiepte<0:"doorboring",%this.BoorDiepte>0:"rugboring",%this.BoorDiepte=0:"puntboring",1:"") . Do TAGWRITE^XMLWRITE(DevObj,"BOORTYPE",%this.BoringType) . Do TAGWRITE^XMLWRITE(DevObj,"BOORDIEPTE",%this.BoorDiepte,"OMS="""_Param_"""") Else Do ;Speciale boring . Set Param=$S(%this.BoringType="BO":"bovenkant",%this.BoringType="EX":"externe",%this.BoringType="IN":"interne",1:"fout profielkant") . Do TAGWRITE^XMLWRITE(DevObj,"BOORTYPE",%this.BoringType,"OMS="""_Param_"""") . Set Param=$S(%this.BoorDiepte<0:"doorboring",%this.BoorDiepte>0:"zijboring",%this.BoorDiepte=0:"puntboring",1:"") . Do TAGWRITE^XMLWRITE(DevObj,"BOORDIEPTE",%this.BoorDiepte,"OMS="""_Param_"""") Set Param="" Set:($E(%this.BoringPlaats,1,2)?1"P"1E) Param=$Case($E(%this.BoringPlaats,1,2), "PL":"links", "PR":"rechts", "PB":"bovenste", "PO":"onderste", :"")_" profiel" Set:(%this.BoringPlaats["VUL") Param=$S(Param'="":Param_" en ",1:"")_"glas" Set:(Param="") Param="fout" Do TAGWRITE^XMLWRITE(DevObj,"BOORPLAATS",%this.BoringPlaats,"OMS="""_Param_"""") Do:($L(%this.Opmerking)) TAGWRITE^XMLWRITE(DevObj,"OPMERKING",%this.Opmerking) Do:($L(%this.CncID)) TAGWRITE^XMLWRITE(DevObj,"CNCID",%this.CncID) Do:($L(%this.VmlID)) TAGWRITE^XMLWRITE(DevObj,"VMLID",%this.VmlID) Set LPos=%this.CalcLPos(GADefProd) Set RandPos=%this.CalcRandPos(GADefProd) Do:(LPos'="") TAGWRITE^XMLWRITE(DevObj,"LPOS",LPos,"UNIT=""mm""") Do:(RandPos'="") TAGWRITE^XMLWRITE(DevObj,"RANDPOS",RandPos,"UNIT=""mm""") Do ENDTAG^XMLWRITE(DevObj,"BORING") ]]> %Library.CacheSerialState emPSBoringState ^Prod.GAD.emKadBoringS AfschuinDiameter BoorDiameter BoringType Opmerking XPos YPos ZPos BoringPlaats BoorGlasDiameter BoorDiepte RelXPos RelYPos RelZPos CncID VmlID CStream