CSDN博客

img xd_w

用Ole Automation实现Delphi和AutoCad之间的数据交换

发表于2001/7/17 12:33:00  1283人阅读

分类: Delphi

 

用Ole Automation实现Delphi和AutoCad之间的数据交换
                      广州 XD.W

    AutoCad是一些做设计的朋友最常用软件之一,有时需要从AutoCad的图纸
中提取数据进行一些计算和优化工作,用手工进行提取工作量非常大;用AutoCad
的AutoLisp、ADS或者ObjectArx进行计算,对不熟悉的人来说掌握起来比较困难,
界面也不够友好。下面我们通过Ole Automation,利用Delphi来实现这一工作,
相关的AutoCad Automation信息请参见AutoCad的帮助文件acadauto.hlp。
    首先在Delphi中建立一个新工程,在主Form放置三个TButton,分别命名为:
btnOpen,btnSend,btnGet,用于实现打开AutoCad,向Cad发送数据,从Cad提取
数据的功能,再放置一个TPaintBox,用于实现输出功能。下面是程序的主单元代码。

unit main;
interface

uses
file://在引用单元中要包含ComObj单元,用于支持Ole操作。
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComObj;

const
file://定义AutoCad中的实体类型常量,本程序中只用到直线,所以只定义了直线的类型常量。
  acLine = 19;

type
file://定义程序中用到的数据结构
  ZPoint = record
    x,y: double;
  end;

  PZLine = ^ZLine;
  ZLine = record
    sp,ep: ZPoint;
    next: PZLine;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    btnOpen: TButton;
    BtnSend: TButton;
    btnGet: TButton;
    PaintBox1: TPaintBox;
    procedure btnOpenClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnGetClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
file://存放数据的指针 
    pData: PZLine;
file://释放存放数据的内存
    procedure FreeData;
  public
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.FreeData;
var
  pTmp: PZLine;
begin
file://释放数据链表内存
  while pData <> nil do begin
    pTmp := pData;
    pData := pData^.next;
    Dispose(pTmp);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
file://在主窗体的创建时初始化数据指针
  pData := nil;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
file://在主窗体的销毁过程中释放内存
  FreeData;
end;

file://打开AutoCad
procedure TForm1.btnOpenClick(Sender: TObject);
var
 AcadApp : OleVariant;
begin
file://通过创建Ole Automation对象启动AutoCad
 AcadApp := CreateOleObject('AutoCad.Application');
 AcadApp.visible := true;
file://OleVariant数据类型是自动释放的,所以这里没有释放代码
end;

file://向AutoCad发送数据
procedure TForm1.btnSendClick(Sender: TObject);
var
  AcadApp: OleVariant;
  AcadDoc: OleVariant;
  AcadMoSpace: OleVariant;
  sp,ep: Variant;
  pTmp: PZLine;
begin
file://得到已启动的AutoCad Application对象
  AcadApp := GetActiveOleObject('AutoCad.Application');
file://得到AutoCad Document对象
  AcadDoc := AcadApp.ActiveDocument;
file://得到AutoCad ModelSpace对象
  AcadMoSpace := AcadDoc.ModelSpace;
file://遍历数据链表
  pTmp := pData;
  while pTmp <> nil do begin
file://创建包含数组的Variant变量sp,用于向AutoCad传递起点数据
   sp := VarArrayCreate([0,2],VarDouble);
    sp[0] := pTmp^.sp.x;
    sp[1] := pTmp^.sp.y;
    sp[2] := 0.0;
file://创建包含数组的Variant变量ep,用于向AutoCad传送终点数据
    ep := VarArrayCreate([0,2],VarDouble);
    ep[0] := pTmp^.ep.x;
    ep[1] := pTmp^.ep.y;
    ep[2] := 0.0;
file://VarArrayRef把包含数组的Variant变量转换成Variant数组,
file://使用AutoCad 14.0时要调用此函数,AutoCad 2000不需要
    AcadMoSpace.AddLine(VarArrayRef(sp),VarArrayRef(ep));
    pTmp := pTmp^.next;
  end;
end;

file://从AutoCad提取数据
procedure TForm1.btnGetClick(Sender: TObject);
var
  AcadApp: OleVariant;
  AcadDoc: OleVariant;
  AcadMoSpace: OleVariant;
  AcadObj: OleVariant;
  AcadPt: Variant;
  i: integer;
  EntiType: Integer;
  pTmp: PZLine;
begin
file://得到所需的AutoCad对象
  AcadApp := GetActiveOleObject('AutoCad.Application');
  AcadDoc := AcadApp.ActiveDocument;
  AcadMoSpace := AcadDoc.ModelSpace;
file://释放以前存放的数据
  FreeData;
file://遍历模型空间中的每一个实体对象
 for i := 0 to AcadMoSpace.Count-1 do begin
file://引用第i个实体对象
    AcadObj := AcadMoSpace.Item(i);
file://提取实体类型
    EntiType := AcadObj.EntityType;
file://判断是不是直线
    if EntiType = acLine then begin
file://如果是直线,则提取相应的起点终点数据
      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];
      pTmp^.next := pData;
      pData := pTmp;
    end;
  end;
file://刷新用于显示结果的PaintBox
  PaintBox1.Invalidate;
end;

file://显示提取的数据
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  MaxX, MaxY: double;
  MinX, MinY: double;
  pTmp: PZLine;
  scale: double;
  x,y: integer;
begin
  pTmp := pData;
  if pTmp = nil then exit;
 
file://计算放缩比例 
  MaxX := pTmp^.sp.x;
  MinX := MaxX;
  MaxY := pTmp^.sp.y;
  MinY := MaxY;
  while pTmp <> nil do begin
    if MaxX < pTmp^.sp.x then MaxX := pTmp^.sp.x;
    if MinX > pTmp^.sp.x then MinX := pTmp^.sp.x;
    if MaxY < pTmp^.sp.y then MaxY := pTmp^.sp.y;
    if MinY > pTmp^.sp.y then MinY := pTmp^.sp.y;
    if MaxX < pTmp^.ep.x then MaxX := pTmp^.ep.x;
    if MinX > pTmp^.ep.x then MinX := pTmp^.ep.x;
    if MaxY < pTmp^.ep.y then MaxY := pTmp^.ep.y;
    if MinY > pTmp^.ep.y then MinY := pTmp^.ep.y;
    pTmp := pTmp^.next;
  end;
  scale := (PaintBox1.Width - 10) / (MaxX-MinX);
  if scale > (PaintBox1.Height - 10) / (MaxY-MinY) then begin
    scale := (PaintBox1.Height - 10) / (MaxY-MinY);
  end;
 
file://显示提取的数据
  pTmp := pData;
  while pTmp <> nil do begin
    x := round((pTmp^.sp.x - MinX) * scale) + 5;
    y := PaintBox1.Height - (round((pTmp^.sp.y - MinY) * scale) + 5);
    PaintBox1.Canvas.MoveTo(x,y);
    x := round((pTmp^.ep.x - MinX) * scale) + 5;
    y := PaintBox1.Height - (round((pTmp^.ep.y - MinY) * scale) + 5);
    PaintBox1.Canvas.LineTo(x,y);
    pTmp := pTmp^.next;
  end;
end;

end.

    本程序在PWin98se+Delphi5.0环境下编译通过,在AutoCad14.0、AutoCad2000
下运行通过,源代码可在此下载:http://wangxd.51.net/software/delphicad.zip

0 0

相关博文

我的热门文章

img
取 消
img