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, <br/>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