⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mian.pas

📁 利用Delphi作为开发环境
💻 PAS
字号:
unit mian;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ComObj, ExtCtrls;

const
  acLine=19;

type
  ZPoint=record
    x,y:double;
  end;//record

  PZLine=^ZLine;

  Zline=record
    sp,ep:ZPoint;
    next:PZline;
  end;//record


  TForm1 = class(TForm)
    btnOpen: TButton;
    btnGet: TButton;
    btnsend: TButton;
    procedure btnOpenClick(Sender: TObject);
    procedure FormCreat(Sender: TObject);
    procedure FormDestory(Sender: TObject);
    procedure btnGetClick(Sender: TObject);
    procedure btnsendClick(Sender: TObject);
  private
    pData:PZline;
    procedure FreeData;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FreeData;
var
  pTmp:PZline;
begin
  while pData<>nil do
  begin
    pTmp:=pData;
    pData:=PData^.next;
    dispose(pTmp);
  end;
end;

procedure TForm1.FormCreat(Sender: TObject);
begin
  pData:=nil;
end;

procedure TForm1.FormDestory(Sender: TObject);
begin
  FreeData;
end;

{打开一个Autocad的应用程序和和一个已经存在的文档}
procedure TForm1.btnOpenClick(Sender: TObject);
var
  obj_Acad:OleVariant;
begin
  try
    obj_Acad:=GetActiveOleObject('AutoCAD.Application.16');
  except
    obj_Acad:=CreateOleObject('AutoCAD.Application.16');
end;
obj_Acad.Visible:=True;
obj_Acad.Documents.open('d:\Line.dwg');
end;

procedure TForm1.btnGetClick(Sender: TObject);
var
  AcadApp:Olevariant;
  AcadDoc:OleVariant;
  AcadMoSpace:Olevariant;
  AcadObj:OleVariant;
  Acadpt:variant;
  i:integer;
  EntiType:integer;
  pTmp:pZline;
  Outputfile:textfile;
begin
  AcadAPP:=GetActiveOleObject('AutoCad.Application.16');
  AcadDoc:=AcadApp.ActiveDocument;
  AcadMoSpace:=AcadDoc.ModelSpace;
  FreeData;
  Assignfile(outputfile,'d:\simput.txt');//为outputfile指定存储路径。
  rewrite(outputfile); //为Assignfile过程指定的文件类型新开一个文件。
  for i:=0 to AcadMoSpace.Count-1 do
  begin
    AcadObj :=AcadMoSpace.Item(i);
    EntiType:=AcadObj.EntityType;
    if EntiType=acLine then
    begin
      new(pTmp);
      AcadPt:=AcadObj.StartPoint;
      pTmp^.sp.x:=AcadPt[0];
      pTmp^.sp.y:=AcadPt[1];
      AcadPt:=AcadObj.Endpoint;
      pTmp^.ep.x:=AcadPt[0];
      pTmp^.ep.y:=AcadPt[1];

      //将直线的起点和终点坐标写到文本文件中
      writeln(Outputfile,i,pTmp^.sp.x,pTmp^.sp.y);
      writeln(Outputfile,i,pTmp^.ep.x,pTmp^.ep.y);
      //将直线的起点和终点坐标写到文本文件中

      pTmp^.next:=pData; //next为记录(数据结构)的一个指针变量
      pData:=pTmp;
    end;
  end;
  closefile(outputfile); //关闭已打开的文本文件
end;

Procedure TForm1.btnSendClick(sender:TObject);
var
  AcadApp:OleVariant;
  AcadDoc:OleVariant;
  AcadMoSpace:OleVariant;
  sp,ep:Variant;
  pTmp:PZline;
begin
  AcadAPP:=GetActiveOleObject('AutoCad.Application');
  AcadDoc:=AcadApp.ActiveDocument;
  AcadMoSpace:=AcadDoc.ModelSpace;
  pTmp:=pData;
  while pTmp <> nil do
  begin
   sp:=VarArrayCreate([0,2],VarDouble);
   ep:=VarArrayCreate([0,2],VarDouble);
   ep[0]:=pTmp^.ep.x;
   ep[1]:=pTmp^.ep.y;
   //ep[0]:=500.;
   //ep[1]:=300.;
   ep[2]:=0.0;
   sp[0]:=100.;
   sp[1]:=200.;
   sp[2]:=0.0;
   AcadMoSpace.AddLine(VarArrayRef(sp),VarArrayref(ep));
   pTmp:=pTmp^.next;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -