sgconsts.pas

CAD转换工具 CAD转换工具 CAD转换工具 CAD转换工具

  // Modes of 3D objects intersection
  TIntersectionMode = (imNone, imPoint, imLine, imPlane);

  // Object snap modes
  TObjectSnapMode = (osNone, osAll, osEndPt, osIntersection, osCenter, osCross,
    osInsert, osImmediate, osMiddle, osDisabled);

  // The entities to be drawn
  TsgCADEnities = (ceEntity, cePoint, ceLine, ceSolid, ceCircle, ceArc, ceEllipse,
     cePolyline, ceLWPolyline, ceSpline, ceLeader, ceInsert, ceDimension, ceMText,
     ceText, ceAttdef, ceAttrib, ce3dFace, ceImageEnt, ceViewport, ceRegion,
     ceBody, ce3DSolid, cePattern, ceGradient, ceOle2Frame, cePolyPolygon,
     ceGradientPolygon, ceCurvePolygon, ceHatch, ceACADTable, ceFlatPoly, ceFlatHatch,
     ceXRef, ceProxy, cePath);
  {$IFNDEF SGDEL_6}
  PCardinal = ^Cardinal;
  {$ENDIF}

const
  cnstFPointZero: TFPoint = ();
  cnstFPointSingle: TFPoint = (X:1; Y:1; Z:1);
  cnstExtrusion: TFPoint = (X: 0; Y: 0; Z: 1);
  cnstF2DPointZero: TF2DPoint = ();
  cnstBad2DRect: TRect = (Left:$7FFF; Top:$7FFF; Right:-$7FFF; Bottom:-$7FFF);
  cnstBadRect: TFRect = (Left: 1E20; Top: -1E20; Z1: 1E20; Right:-1E20; Bottom: 1E20; Z2: -1E20);
  cnstIdentityMat: TFMatrix = ((1, 0, 0), (0, 1, 0), (0, 0, 1), (0, 0, 0));
  cnstBorderSize: Double = 1 / 8;
  cnstBorderType: TsgBorderType = btRatio;

function BinSearch(List: TList; Comp: TListSortCompare; var Index: Integer; var Param): Boolean;
function Degree(ARadian: Extended): Extended;
procedure ClearList(AList: TList);
procedure ClearRecordList(AList: TList);
procedure ClearRecordListOfList(AListOfList: TList);
procedure ClearListWithNilCheck(List: TList);
function CompareDXFPointByXCoord(Item1, Item2: Pointer): Integer;
function CompareDXFPointByYCoord(Item1, Item2: Pointer): Integer;
function CompareFPointByXCoord(Item1, Item2: Pointer): Integer;
function CompareFPointByYCoord(Item1, Item2: Pointer): Integer;
function ConvToFloatDef(const S: string; const Value: Extended): Extended;
procedure ExpandFRect(var R: TFRect; const P: TFPoint);
function FindAutoCADSHXPaths(APaths: TStringList): Boolean;
procedure FreeList(var AList: TList);
procedure FreeRecordList(var AList: TList);
procedure FreeRecordListOfList(var AListOfList: TList);
function MakeDXFPoint(const X, Y, Z: Single): TdxfPoint;
function MakeFPoint(X, Y, Z: TsgFloat): TFPoint;
function MakeF2DPoint(const X, Y: TsgFloat): TF2DPoint;
function MakeFRect(Left, Top, Z1, Right, Bottom, Z2: TsgFloat): TFRect;
function MakeDXFFromFPoint(const AFPoint: TFPoint): TdxfPoint;
function MakeFPointFromDXF(const AdxfPoint: TdxfPoint): TFPoint;
function MakeRightPath(APath: string): string;
function FloatPoint(X, Y: Extended): TFPoint;
function FloatRect(ALeft, ATop, ARight, ABottom: Extended): TFRect;
function FltPoint3D(X, Y, Z: Extended): TFPoint;
function IdentityMat: TFMatrix;
function IsEqual(const AVal1, AVal2: TsgFloat): Boolean;
function IsEqualPoints(const Point1, Point2: TPoint): Boolean;
function IsEqualFPoints(const Point1, Point2: TFPoint): Boolean;
function IsEqualF2DPoints(const Point1, Point2: TF2DPoint): Boolean;
function TransposeMat(const AMatrix: TFMatrix): TFMatrix;
procedure TransRectCorners(var ARect: TFRect; const AMatrix: TFMatrix);
function IsRotated(const M: TFMatrix): Boolean;
//function MatFromExtr(const P: TFPoint; Angle: Single): TFMatrix;
procedure MatOffset(var M: TFMatrix; const P: TFPoint);
function MatXMat(const A,B: TFMatrix): TFMatrix;
function PtXMat(const P: TFPoint; const M: TFMatrix): TFPoint;
function Radian(Angle: Extended): Extended;
procedure ReplaceAnsi(var S: string; const S1, S2: string);
procedure SortList(AList: PPointerList; ACompareFunc: TListSortCompare;
  ALeftPos, ARightPos: Integer);
function StdMat(const S, P: TFPoint): TFMatrix;
procedure SwapSGFloats(var A, B: TsgFloat);
function Proportional(const XInput, YInput, AOutput: TsgFloat; AOutputIsX : Boolean): TsgFloat; //For internal using
function Min(const A, B: Double): Double;
function Max(const A, B: Double): Double;
function GetIntersectingPoint(const Line1, Line2: TsgLine; var IntersectionMode: TIntersectionMode): TFPoint;
function GetIntresectingRectAndLine(const ARect: TFRect; const ALine: TsgLine; var IntersectionMode: TIntersectionMode): TsgLine;
function MaxTsgFloat: Extended;
function DistanceF(APoint1, APoint2: TFPoint): TsgFloat;
function DistanceI(APoint1, APoint2: TPoint): Double;
procedure SwapInts(var A,B);
{$IFNDEF SGDEL_6}
function WideUpperCase(const S: WideString): WideString;
{$ENDIF}

implementation

uses Math, SysUtils, Graphics;

function BinSearch(List: TList; Comp: TListSortCompare; var Index: Integer; var Param): Boolean;
var
  C,L,R: Integer;
begin
  Result := False;
  Index := 0;
  L := 0;
  R := List.Count;
  while True do
  begin
    Index := (L + R) shr 1;
    if L = R then
      Exit;
    C := Comp(List[Index], @Param);
    Result := C=0;
    if Result then
      Exit;
    if C > 0 then
      R := Index
    else
      L := Index+1;
  end;
end;

function Proportional(const XInput, YInput, AOutput: TsgFloat; AOutputIsX : Boolean): TsgFloat;
begin
  if (XInput = 0)or(YInput = 0) then
  begin
    Result := AOutput;
    Exit;
  end;
  if AOutputIsX then
    Result := YInput * AOutput / XInput
  else
    Result := XInput * AOutput / YInput;
end;

function ConvToFloatDef(const S: string; const Value: Extended): Extended;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then
  begin
    Dec(E);
    Val(Copy(S, 1, E), Result, E);
    if (E <> 0) and (Result = 0) then
      Result := Value;
  end;
end;

procedure ExpandFRect(var R: TFRect; const P: TFPoint);
begin
  if R.Left > P.X then
    R.Left := P.X;
  if R.Top < P.Y then
    R.Top := P.Y;
  if R.Z1 > P.Z then
    R.Z1 := P.Z;
  if R.Right < P.X then
    R.Right := P.X;
  if R.Bottom > P.Y then
    R.Bottom := P.Y;
  if R.Z2 < P.Z then
    R.Z2 := P.Z;
end;

function Degree(ARadian: Extended): Extended;
begin
  Result := ARadian * f180DividedByPi;
end;

function MakeDXFPoint(const X, Y, Z: Single): TdxfPoint;
begin
  Result.X := X;
  Result.Y := Y;
  Result.Z := Z;
end;

function MakeFPoint(X, Y, Z: TsgFloat): TFPoint;
begin
  Result.X := X;
  Result.Y := Y;
  Result.Z := Z;
end;

function MakeF2DPoint(const X, Y: TsgFloat): TF2DPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

function MakeFRect(Left, Top, Z1, Right, Bottom, Z2: TsgFloat): TFRect;
begin
  Result.Left := Left;
  Result.Top := Top;
  Result.Z1 := Z1;
  Result.Right := Right;
  Result.Bottom := Bottom;
  Result.Z2 := Z2;
end;

function MakeFPointFromDXF(const AdxfPoint: TdxfPoint): TFPoint;
begin
  Result.X := AdxfPoint.X;
  Result.Y := AdxfPoint.Y;
  Result.Z := AdxfPoint.Z;
end;

function MakeDXFFromFPoint(const AFPoint: TFPoint): TdxfPoint;
begin
  Result.X := AFPoint.X;
  Result.Y := AFPoint.Y;
  Result.Z := AFPoint.Z;
end;

function MakeRightPath(APath: string): string;
var
  L: Integer;
begin
  L := Length(APath);
  if L > 0 then
    if APath[L] <> '\' then
      APath := APath + '\';
  Result := APath;
end;

function FloatPoint(X, Y: Extended): TFPoint;
begin
  Result.X := X;
  Result.Y := Y;
  Result.Z := 0;
end;

function FloatRect(ALeft, ATop, ARight, ABottom: Extended): TFRect;
begin
  Result.Left := ALeft;
  Result.Top := ATop;
  Result.Z1 := 0;
  Result.Right := ARight;
  Result.Bottom := ABottom;
  Result.Z2 := 0;
end;

function FltPoint3D(X, Y, Z: Extended): TFPoint;
begin
  Result.X := X;
  Result.Y := Y;
  Result.Z := Z;
end;

function Radian(Angle: Extended): Extended;
begin
  Result := Angle * fPiDividedBy180;
end;

procedure ReplaceAnsi(var S: string; const S1, S2: string);
var
  P, Counter, Len1, Len2: Integer;
  vStr, vStr1: string;
begin
  vStr := Lowercase(S);
  vStr1 := Lowercase(S1);
  Len1 := Length(S1);
  Len2 := Length(S2);
  Counter := 0;
  while True do
  begin
    P := Pos(vStr1, vStr);
    if P = 0 then
      Exit;
    Delete(vStr, 1, P + Len1 - 1);
    Delete(S, P + Counter, Len1);
    Inc(Counter, P);
    if S2 <> '' then
    begin
      Insert(S2, S, Counter);
      Inc(Counter, Len2-1);
    end;
  end;
end;

procedure SwapSGFloats(var A, B: TsgFloat);
var
  C: TsgFloat;
begin
  C := A;
  A := B;
  B := C;
end;

function PtXMat(const P: TFPoint; const M: TFMatrix): TFPoint;
  function Part(I: Integer): Extended;
  begin
    Result := P.X * M[0,I] + P.Y * M[1,I] + P.Z * M[2,I] + M[3,I];
  end;
begin
  Result.X := Part(0);
  Result.Y := Part(1);
  Result.Z := Part(2);
end;

function MatXMat(const A,B: TFMatrix): TFMatrix;
var
  I,J: Integer;
begin
  for I := 0 to 3 do
  begin
    for J := 0 to 2 do
      Result[I,J] := A[I,0] * B[0,J] + A[I,1] * B[1,J] + A[I,2] * B[2,J];
  end;
  for J := 0 to 2 do
    Result[3,J] := Result[3,J] + B[3,J];
end;

function IsRotated(const M: TFMatrix): Boolean;
var
  I,J: Integer;
begin
  Result := False;
  for I := 0 to 2 do
  begin
    for J := 0 to 2 do
    begin
      if I = J then
        Continue;
      Result := Abs(M[I,J]) > fAccuracy;
      if Result then
        Exit;
    end;
  end;
end;

procedure MatOffset(var M: TFMatrix; const P: TFPoint);
begin
  M[3,0] := P.X;
  M[3,1] := P.Y;
  M[3,2] := P.Z;
end;

function StdMat(const S,P: TFPoint): TFMatrix;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result[0,0] := S.X;
  Result[1,1] := S.Y;
  Result[2,2] := S.Z;
  MatOffset(Result,P);
end;

function IdentityMat: TFMatrix;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result[0,0] := 1;
  Result[1,1] := 1;
  Result[2,2] := 1;
end;

function TransposeMat(const AMatrix: TFMatrix): TFMatrix;
begin
  Result[0, 0] := AMatrix[0,0];
  Result[1, 0] := AMatrix[0,1];
  Result[2, 0] := AMatrix[0,2];
  Result[0, 1] := AMatrix[1,0];
  Result[1, 1] := AMatrix[1,1];
  Result[2, 1] := AMatrix[1,2];
  Result[0, 2] := AMatrix[2,0];
  Result[1, 2] := AMatrix[2,1];
  Result[2, 2] := AMatrix[2,2];
  Result[3, 0] := -AMatrix[3,0];
  Result[3, 1] := -AMatrix[3,1];
  Result[3, 2] := -AMatrix[3,2];
end;

procedure TransRectCorners(var ARect: TFRect; const AMatrix: TFMatrix);
var
  R: TFRect;

  procedure ExpR(const X, Y, Z: TsgFloat);
  begin
    ExpandFRect(R, PtXMat(MakeFPoint(X, Y, Z), AMatrix));
  end;

begin
  R := cnstBadRect;
  ExpR(ARect.Left, ARect.Top, ARect.Z1);
  ExpR(ARect.Left, ARect.Top, ARect.Z2);
  ExpR(ARect.Left, ARect.Bottom, ARect.Z1);
  ExpR(ARect.Left, ARect.Bottom, ARect.Z2);
  ExpR(ARect.Right, ARect.Top, ARect.Z1);
  ExpR(ARect.Right, ARect.Top, ARect.Z2);
  ExpR(ARect.Right, ARect.Bottom, ARect.Z1);
  ExpR(ARect.Right, ARect.Bottom, ARect.Z2);
  ARect := R;
end;

{ SortList

  Sorts the list. }
procedure SortList(AList: PPointerList; ACompareFunc: TListSortCompare;
  ALeftPos, ARightPos: Integer);
var
  K, N: Integer;
  PItem, PElem: Pointer;
begin
  repeat
    K := ALeftPos;
    N := ARightPos;
    PItem := AList^[(ALeftPos + ARightPos) shr 1];
    repeat
      while ACompareFunc(AList^[K], PItem) < 0 do
        Inc(K);
      while ACompareFunc(AList^[N], PItem) > 0 do
        Dec(N);
      if K <= N then
      begin
        PElem := AList^[K];
        AList^[K] := AList^[N];
        AList^[N] := PElem;
        Inc(K);
        Dec(N);
      end;
    until (K > N);
    if ALeftPos < N then
      SortList(AList, ACompareFunc, ALeftPos, N);
    ALeftPos := K;