GLS.FileDEL.pas 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135
  1. //
  2. // The multimedia graphics platform GLScene https://github.com/glscene
  3. //
  4. unit GLS.FileDEL;
  5. (*
  6. Supports to import TetGen files from http://wias-berlin.de/software/tetgen/fformats.html
  7. combined in a DEL ASCII file for Delaunay tetrahedralization.
  8. *)
  9. interface
  10. {$I GLScene.inc}
  11. uses
  12. System.Classes,
  13. System.SysUtils,
  14. GLS.VectorTypes,
  15. GLS.VectorFileObjects,
  16. GLS.ApplicationFileIO,
  17. GLS.VectorGeometry,
  18. GLS.VectorTypesExt,
  19. GLS.Utils;
  20. type
  21. (* The DEL vector file (tetrahedra irregular network)*)
  22. TGLDELVectorFile = class(TGLVectorFile)
  23. public
  24. class function Capabilities: TGLDataFileCapabilities; override;
  25. procedure LoadFromStream(aStream : TStream); override;
  26. end;
  27. // ------------------------------------------------------------------
  28. implementation
  29. // ------------------------------------------------------------------
  30. const
  31. cNODE_LABEL = 'node';
  32. cEDGE_LABEL = 'edge';
  33. cFACE_LABEL = 'face';
  34. cCELL_LABEL = 'ele';
  35. cNEIGH_LABEL = 'neigh';
  36. // ------------------
  37. // ------------------ TGLDELVectorFile ------------------
  38. // ------------------
  39. class function TGLDELVectorFile.Capabilities: TGLDataFileCapabilities;
  40. begin
  41. Result:=[dfcRead];
  42. end;
  43. procedure TGLDELVectorFile.LoadFromStream(aStream : TStream);
  44. var
  45. i, j : Integer;
  46. sl, tl : TStringList;
  47. mesh : TGLMeshObject;
  48. v1, v2, v3, n : TAffineVector;
  49. ActiveTin : Boolean;
  50. Id_Tin : Integer;
  51. Tnam: string;
  52. Id_Mat, NVert, NTri : Integer;
  53. VertArr : TPoint3DArray;
  54. n1, n2, n3 : Integer;
  55. begin
  56. sl := TStringList.Create;
  57. tl := TStringList.Create;
  58. i := 0;
  59. try
  60. sl.LoadFromStream(aStream);
  61. mesh := TGLMeshObject.CreateOwned(Owner.MeshObjects);
  62. mesh.Mode := momTriangles;
  63. // the file with nodes, edges, faces and eles described by triangles and materials
  64. while i < sl.Count - 1 do
  65. begin
  66. Inc(i);
  67. tl.DelimitedText := sl[i];
  68. if (tl.CommaText = 'BEGT') then // the beginning of new tin
  69. begin
  70. repeat
  71. Inc(i); tl.DelimitedText := sl[i];
  72. if (tl[0] = 'ACTIVETIN') then
  73. ActiveTin := True;
  74. if (tl[0] = 'ID') then
  75. Id_Tin := StrToInt(tl[1]);
  76. if (tl[0] = 'TNAM') then
  77. Tnam := tl[1];
  78. if (tl[0] = 'MAT') then
  79. Id_Mat := StrToInt(tl[1]);
  80. if (tl[0] = 'VERT') then
  81. NVert := StrToInt(tl[1]);
  82. until tl[0]='VERT';
  83. SetLength(VertArr, NVert);
  84. j := 0;
  85. repeat
  86. Inc(i);
  87. tl.DelimitedText := sl[i];
  88. VertArr[j].X := GLStrToFloatDef(tl[0]);
  89. VertArr[j].Y := GLStrToFloatDef(tl[1]);
  90. VertArr[j].Z := GLStrToFloatDef(tl[2]);
  91. Inc(j);
  92. until (j = NVert);
  93. Inc(i);
  94. tl.DelimitedText := sl[i];
  95. NTri := StrToInt(tl[1]);
  96. j := 0;
  97. repeat
  98. Inc(i); Inc(j);
  99. tl.DelimitedText := sl[i];
  100. n1 := StrToInt(tl[0]); n2 := StrToInt(tl[1]); n3 := StrToInt(tl[2]);
  101. SetVector(v1, VertArr[n1-1].X, VertArr[n1-1].Y, VertArr[n1-1].Z);
  102. SetVector(v2, VertArr[n2-1].X, VertArr[n2-1].Y, VertArr[n2-1].Z);
  103. SetVector(v3, VertArr[n3-1].X, VertArr[n3-1].Y, VertArr[n3-1].Z);
  104. mesh.Vertices.Add(v1, v2, v3);
  105. n := CalcPlaneNormal(v1, v2, v3);
  106. mesh.Normals.Add(n, n, n);
  107. until (j = NTri);
  108. Inc(i); tl.DelimitedText := sl[i]; //tl.DelimitedText = 'ENDT';
  109. end;
  110. end;
  111. finally
  112. tl.Free;
  113. sl.Free;
  114. end;
  115. end;
  116. // ------------------------------------------------------------------
  117. initialization
  118. // ------------------------------------------------------------------
  119. RegisterVectorFileFormat('delaunay', 'Triangular Irregular Network', TGLDELVectorFile);
  120. end.