Data exchange between Delphi and AutoCAD with Ole Automation

Guangzhou xd.w

AutoCAD is one of the most common software for designing friends. Sometimes you need to extract data from AutoCAD's drawings to make some calculations and optimization work, and use manual extraction work. It is very large; use AutoCAD's Autolisp, ADS or ObjectARX to calculate, People who are unfamiliar are more difficult to master, and the interface is not friendly. Below we use the Ole Automation, use Delphi to implement this, see AutoCAD Automation information, see AutoCAD's help file acadauto.hlp. First, create a new project in Delphi, lay three TButton in the master form, named: btnopen, btnsend, btnget, to implement the Open AutoCAD, send data to CAD, extract data from CAD, then place a TPAINTBOX, Used to implement the output function. Below is the main unit code of the program.

Unit main; interface

Usesfile: / / In the reference unit, you want to include a COMOBJ unit for supporting OLE operations. Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, Extctrls, COMOBJ

Constfile: / / Define the physical type constants in AutoCAD, only lines in this program, so the type constant of the straight line is defined. ACline = 19;

Typefile: // Defines the data structure used in the program ZPoint = Record x, Y: Double; END;

PZLINE = ^ zline; zline = record sp, ep: zpoint; next: pzline;

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); privatefile: // pointer storage pData data: PZLine; file: // procedure FreeData release of memory storage of data; public end ;

Var Form1: TFORM1;

Implementation {$ r * .dfm}

Procedure tform1.freedata; var ptmp: pzline; beginfile: // Release data Link table memory while pdata <> nil do beg ptmp: = pdata; pdata: = pdata ^ .next; dispose (ptmp); end;

Procedure TFORM1.FormCreate (Sender: TOBJECT); Beginfile: / / Initialization Data Pointer PDATA: = NIL; END;

procedure TForm1.FormDestroy (Sender: TObject); beginfile: // released during the destruction of the main form memory FreeData; end; file: // Open AutoCadprocedure TForm1.btnOpenClick (Sender: TObject); var AcadApp: OleVariant; beginfile: // Start AutoCAD Acadapp: = CreateoleObject ('AutoCad.Application') by creating an OLE Automation object; acadapp.visible: = true; file: // olevariant data type is automatically released, so there is no release code end;

file: // send data to AutoCad procedure TForm1.btnSendClick (Sender: TObject); var AcadApp: get started in AutoCad //: OleVariant; AcadDoc: OleVariant; AcadMoSpace: OleVariant; sp, ep: Variant;:; pTmp beginfile PZLine Application object AcadApp: = GetActiveOleObject ( 'AutoCad.Application'); file: // get AutoCad Document Object AcadDoc: = AcadApp.ActiveDocument; file: // get AutoCad ModelSpace objects AcadMoSpace: = AcadDoc.ModelSpace; file: // through the data Link list ptmp: = pdata; while ptmp <> nil do beginfile: // Create a Variant Variable SP containing an array, to pass the starting data sp: = varArRaycreate ([0, 2], vardouble); sp [0]: = PTMP ^ .sp.x; sp [1]: = ptmp ^ .sp.y; sp [2]: = 0.0; file: // Create a Variant variable EP containing array to transfer endpoint data to AutoCAD: = VararrayCreate; EP [0]: = PTMP ^ .ep.x; EP [1]: = ptmp ^ .ep.y; EP [2]: = 0.0; file: // VaraRrayRef converts the Variant variable containing an array into a Variant array, file: // to call this function when using AutoCAD 14.0, AutoCAD 2000 does not require AcadMospace.AddLine (Vararrayref (SP), Vararrayref (EP)); PTMP: = PTMP ^. Next; end;

file: // extract data from AutoCad procedure TForm1.btnGetClick (Sender: TObject); var AcadApp: OleVariant; AcadDoc: OleVariant; AcadMoSpace: OleVariant; AcadObj: OleVariant; AcadPt: Variant; i: integer; EntiType: Integer; pTmp: PZLine ; beginfile: // get the desired object AutoCad AcadApp: = GetActiveOleObject ( 'AutoCad.Application'); AcadDoc: = AcadApp.ActiveDocument; AcadMoSpace: = AcadDoc.ModelSpace; file: // release data previously stored FreeData; file: // Traverse each entity object in the model space for i: = 0 to acadmospace.count-1 do beginfile: // Reference Ionic object acadobj: = acadMospace.Item (i); file: // Extract entity type Entitype: = acadobj.entityType; file: // Judgment is a straight line if entitype = acline thrinefile: // If it is a straight line, extract the corresponding start-point end data 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: // Refresh for display of PaintBox PaintBox1.inValidate; End;

File: // Display the extracted data 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 dam; file: // calculates the deflation ratio maxx: = ptmp ^ .sp.x; minx: = maxx; maxy: = ptmp ^ .sp.y; miny: = maxy; while ptmp <> NIL DO BEGIN if Maxx ptmp ^ .sp.x then minx: = ptmp ^ .sp.x; if maxy PTMP ^ .sp.y damy: = ptmp ^ .sp.y; if Maxx PTMP ^ .ep.x thein minx: = ptmp ^ .ep.x; if maxy PTMP ^ .ep . Y miny: = ptmp ^ .ep.y; ptmp: = ptmp ^ .next; end; scale: = (PaintBox1.width - 10) / (MAXX-minx); if scale> (Paintbox1.Height - 10) / (MAXY-Miny) THEN BEGIN SCALE: = (Maxy-miny); End; File: // Displays the extracted data PTMP: = pdata; while ptmp <> nil do begin x: = Round ((ptmp ^ .sp.x - minx) * scale) 5; Y: = PaintBox1.Height - ((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.

This program compiled in the PWIN98se Delphi5.0 environment, running at AutoCAD14.0, AutoCAD2000, source code can be downloaded here: http://wangxd.51.net/software/delphicad.zip.