专注于互联网--专注于架构

最新标签
网站地图
文章索引
Rss订阅

首页 »Delphi教程 » delphi开发:delphi开发CAD »正文

delphi开发:delphi开发CAD

来源: 发布时间:星期日, 2008年10月19日 浏览:178次 评论:0
准备工作:打开DELPHI,project---〉import typelibrary 点ADD,添加C:\Program Files\Common Files\Autodesk Shared\acax16chs.tlb。install。
下面是程序,都是基于VBA的,和VBA相似

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj, AutoCAD_TLB;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
ComboBox1: TComboBox;
procedure Button1Click(Sender: TObject);
function drawline(a1,b1,a2,b2:Real;layers:string):Boolean;
function drawtext(text:string;a,b:Real;high:Real;flag:Boolean;layers:string):Boolean;
function drawwideline(a1,b1,a2,b2,a3,b3,a4,b4,a5,b5:Real;flag:boolean;layers:string):Boolean;
function drawrectangle(a1,b1,a2,b2:Real;flag:boolean;layers:string):Boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;line:Acadline;acad:AcadApplication;aPolygon: AcadLWPolyline;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var fangxiangtxt:Boolean;
begin
try
acad:=GetActiveOleObject('AutoCAD.Application.16') as AcadApplication;
except
acad:=CreateOleObject('AutoCAD.Application.16') as AcadApplication;
end;
Acad.Documents.Open('D:\1.dwg',false,false); //打开CAD;参数:(路径,是否只读,是否加密),没有这句就是新建CAD
acad.Visible:=True;
drawline(0,0,100,100,'SB'); //画直线;参数:(起点(x,y)、终点(x,y)、图层)
drawtext('asds//adas',100,100,20,false,'SB');//写文本;参数:(文本,坐标,高度,横/竖,图层)
drawrectangle(0,0,100,100,true,'SB')// 画矩形;参数:(对角两点的坐标,粗/细,图层)
end;
function TForm1.drawline(a1,b1,a2,b2:Real;layers:string):Boolean;
var vpoint1,vpoint2:OleVariant;
begin
vpoint1:=varArrayCreate([0,2],varDouble);
vpoint2:=varArrayCreate([0,2],varDouble);
vpoint1[0]:=a1; vpoint1[1]:=b1; vpoint1[2]:=0;
vpoint2[0]:=a2; vpoint2[1]:=b2; vpoint2[2]:=0;
line:=acad.ActiveDocument.ModelSpace.Addline(vpoint1,vpoint2);
line.Layer:=layers;
line.Update;
end;

function TForm1.drawtext(text:string;a,b:Real;high:Real;flag:Boolean;layers:string):Boolean;
var vpoint:OleVariant;cc:widestring;bb:wordbool;dd:wordbool;ee:integer;ff:integer;
begin
vpoint:=varArrayCreate([0,2],varDouble);
vpoint[0]:=a; vpoint[1]:=b; vpoint[2]:=0;
flag:=false;
if flag then
begin
acad.ActiveDocument.ActiveTextStyle.setFont(cc,bb,dd,ee,ff);
acad.ActiveDocument.ModelSpace.Addtext(text,vpoint,high).Layer:=layers;
end
else// 本来想用这段实现从上到下排列的单行文字但是未果,
begin
acad.ActiveDocument.ActiveTextStyle.FontFile:='C:\Program Files\AutoCAD 2004\Fonts\txt.shx';
acad.ActiveDocument.ModelSpace.Addtext(text,vpoint,high).VerticalAlignment:=acVerticalAlignmentMiddle;
end;
//acad.ActiveDocument.ModelSpace.AddText()
//
//edit1.text:=cc;
end;

function Tform1.drawwideline(a1,b1,a2,b2,a3,b3,a4,b4,a5,b5:Real;flag:boolean;layers:string):Boolean;
var pline:OleVariant ;
begin
pline:=varArrayCreate([0,9],varDouble);
pline[0]:=a1; pline[1]:=b1; pline[2]:=a2; pline[3]:=b2; pline[4]:=a3; pline[5]:=b3;
pline[6]:=a4; pline[7]:=b4; pline[8]:=a5; pline[9]:=b5;
if flag then
begin
aPolygon:=acad.ActiveDocument.ModelSpace.AddLightWeightPolyline(pline);
aPolygon.ConstantWidth:=10;
aPolygon.Layer:=layers;
end
else
begin
aPolygon:=acad.ActiveDocument.ModelSpace.AddLightWeightPolyline(pline);
aPolygon.Layer:=layers;
end;
// acad.ActiveDocument.ModelSpace.AddMLine(pline)//多线,两条平行的,只要指定2个点;
end;
function Tform1.drawrectangle(a1,b1,a2,b2:Real;flag:boolean;layers:string):Boolean;
begin
drawwideline(a1,b1,a1,b2,a2,b2,a2,b1,a1,b1,flag,layers);
end;

end.

以上程序调试,运行成功
标签:delphi开发
0

相关文章

读者评论

发表评论

  • 昵称:
  • 内容: