Izris elipse

Rutina nariše elipse (poligone) okoli filtriranih točk, ki so v plasti Skica točk. Kot atributi morajo biti pri točkah zapisane vednosti dolžin osi a in b ter azimut stranice a.

Sub NarisiElipse(M As Long)
 /*M je faktor povečave osi elipse*/
 Dim LP As TLayer, F1, F2, F3 As TField, I, J As Long, Y, X, DY, DX, A, DA As Float, 
PA As TPointArray, SA, CA, SB, CB As Float
 LP = [Skica točk] //Plast s točkovno in ploskovno topologijo
 F1 = LP.GetField ('[Os a]')
 F2 = LP.GetField ('[Os b]')
 F3 = LP.GetField ('[DTheta]')
 LP.Filter.Clear
 LP.Filter.SQL = '([Os a].AsNumber > 0)'
 LP.Filter.Execute
 If LP.FilteredRecords.Count > 0 Then
   LP.BeginMultipleUpdate
   For I = 0 To LP.FilteredRecords.Count - 1
     Y = LP.FilteredRecords.Items(I).Y
     X = LP.FilteredRecords.Items(I).X
     LP.EditRecord.Edit (LP.FilteredRecords.Items(I))
     DY = LP.EditRecord.FldAsNumber (F1) * M
     DX = LP.EditRecord.FldAsNumber (F2) * M
     A = DegToRad (90 - LP.EditRecord.FldAsNumber (F3))
     CB = Cos (A)
     SB = Sin (A)
     PA = CreatePointArray
     For J = 0 To 359 Step 15
       DA = DegToRad (J)
       CA = Cos (DA)
       SA = Sin (DA)
       PA.AddPoint (Y + DY * CA * CB - DX * SA * SB, X + DY * CA * SB + DX * SA * CB)
     Next
     LP.EditRecord.SetPolygon
     LP.EditRecord.AddPointArray (PA)
     LP.EditRecord.Update
     Destroy (PA)
   Next
   LP.EndMultipleUpdate
 EndIf
EndSub

Za uporabo rutine si pripravimo gumb na orodjarni. Več o tem je v poglavju Urejevalnik orodjarne.

Nazaj na Zanimive rutine