Download atrBrowser BETA for DataCAD 15 (Updated 11.03.2012)
Download atrBrowser BETA for DataCAD 14 (Updated 11.03.2012)
Download atrBrowser BETA for DataCAD 13 (Updated 11.20.2010)
'atrBrowser' BETA is a DCAL for Delphi Macro. I developed this macro to learn how to incorporate Delphi forms into a DataCAD macro.
This macro allows you to browse all of the attributes that may be stored with the drawing, entities, layers, and symbols. The attributes are organized alphabetically by name.
Enjoy!
Here is the source code for the main unit 'atrBrowser.dpr':
Here it the source code for the main form unit 'atrBrowserForm.pas':
Download atrBrowser BETA for DataCAD 14 (Updated 11.03.2012)
Download atrBrowser BETA for DataCAD 13 (Updated 11.20.2010)
'atrBrowser' BETA is a DCAL for Delphi Macro. I developed this macro to learn how to incorporate Delphi forms into a DataCAD macro.
This macro allows you to browse all of the attributes that may be stored with the drawing, entities, layers, and symbols. The attributes are organized alphabetically by name.
Enjoy!
Here is the source code for the main unit 'atrBrowser.dpr':
Code: Select all
{
DCAL program atrBrowser.
}
library atrBrowser;
uses
atrBrowserForm in 'atrBrowserForm.pas' {atrForm},
Forms,
UConstants in '..\..\Header Files\UConstants.pas',
UInterfaces in '..\..\Header Files\UInterfaces.pas',
UInterfacesRecords in '..\..\Header Files\UInterfacesRecords.pas',
URecords in '..\..\Header Files\URecords.pas',
UVariables in '..\..\Header Files\UVariables.pas';
{$E dmx}//dmx is the extension for DCAL Dll's
{$R *.res}
//The values stored in the records you define here will be rememberd
//between dispatcher calls because they are pushed onto the command stack
type
atrBrowserL = record
state: asint;
doDrawing, doEntity, doLayer, doSymbol, doView, doDetail: boolean;
case byte of
0: (getp: getpointArg);
end;
PatrBrowserL = ^atrBrowserL;
//Main Function (Re-entrant State Machine)
function atrBrowser_main(act : action; pl, pargs : Pointer) : wantType;
//The values stored in variables you define here will not be retained
//between dispatcher calls because they are not pushed onto the stack
var
retval : asint;
l : PatrBrowserL;
begin
l := PatrBrowserL(pl);
{Section 3: Aagain - Return to menus and wait for input}
if act = aagain then begin { Re-entrant section }
case l.state of { Case }
1 :
begin
//If a key was pressed or a menu button was selected...
if l.getp.Result = res_escape then begin
case l.getp.key of
f1 : l.state := 2; {Show Form}
f3 : l.doDrawing := not l.doDrawing;
f4 : l.doEntity := not l.doEntity;
f5 : l.doLayer := not l.doLayer;
f6 : l.doSymbol := not l.doSymbol;
f7 : l.doView := not l.doView;
f8 : l.doDetail := not l.doDetail;
s0 : l.state := 0; {Exit}
end; { Which key was pressed }
end; { Was a key pressed or menu selected? }
end; { 1 }
2 :
begin
l.state := 1;
end; { 2 }
else
l.state := 0;
end; { Case }
end; { Re-entrant Section }
{Section 2: Afirst - Tasks to perform only once}
if act = Afirst then begin //Initialize local state and other variables
wrterr('Attribute Browser Macro BETA - Version 1.0.0.5');
l.state := 1;
l.doDrawing := True;
l.doEntity := True;
l.doLayer := True;
l.doSymbol := True;
l.doView := True;
l.doDetail := True;
end
{Section 4: Alast - If your macro has been interrupted by user action}
else if act = Alast then begin
//If you're going to get blown off the stack...
//(i.e.) the user pressed a hotkey,
//then this is your last chance to clean up temporary data.
end
{Section 1: AlSize - Allocate memory on stack for local variables}
else if act = AlSize then begin
SetLocalSize(sizeof(l^));
end;
if act <> alsize then begin { Action section - Invoke the Dispatcher }
case l.state of
1 :
begin { 1: Main Menu }
wrtlvl('atrBrowser'); //Set Menu Title
lblsinit;
lblset(1, 'Attributes', 'Display drawing attributes');
lblsett(3, 'Drawing', l.doDrawing, 'Search Drawing Attributes');
lblsett(4, 'Entity', l.doEntity, 'Search Entity Attributes');
lblsett(5, 'Layer', l.doLayer, 'Search Layer Attributes');
lblsett(6, 'Symbol', l.doSymbol, 'Search Symbol Attributes');
lblsett(7, 'View', l.doView, 'Search View Attributes');
lblsett(8, 'Detail', l.doDetail, 'Search Detail Attributes');
lblson1;
getpointp(vmode_edit, True, l.getp, retval); //Don't change view to Ortho
{Dispatcher will call as soon as it has control, go to Aagain: 1}
end; { 1 }
2 :
begin
atrForm := TatrForm.Create(Application);
atrForm.doDrawing := l.doDrawing;
atrForm.doEntity := l.doEntity;
atrForm.doLayer := l.doLayer;
atrForm.doSymbol := l.doSymbol;
atrForm.doView := l.doView;
atrForm.doDetail := l.doDetail;
atrForm.ShowModal;
atrForm.Free;
callNone(retval);{ You have to ask the Dispatcher to do something. }
{ In this case, ask the dispatcher to do nothing. }
{Dispatcher will call as soon as it has control, go to Aagain: 2}
end; { 2 }
else
retval := XDone; //Don't go back to Aagain
end; { Case }
end; { Action section }
Result := retval;
end; { atrBrowser_main }
//End Main Function (Re-entrant State Machine)
function Main(dcalstate : asint; act : action;
pl, pargs : Pointer) : wantType; stdcall;
begin
case dcalstate of
XDcalStateBegin : Result := atrBrowser_main(act, pl, pargs);
else
Result := XDone;{Necessary}
end;
end;
//End of Main Function (Re-entrant State Machine)
exports
Main;{This is the entry function that will be called by DataCAD.
All DCAL Dlls will have this function.}
begin
end.
Here it the source code for the main form unit 'atrBrowserForm.pas':
Code: Select all
unit atrBrowserForm;
interface
uses
Classes, Controls, Dialogs, Forms,
Graphics, Grids,
Messages, StdCtrls,
SysUtils, ValEdit, Variants, Windows;
type
TatrForm = class(TForm)
ValueListEditor1 : TValueListEditor;
procedure FormShow(Sender : TObject);
private
{ Private declarations }
public
{ Public declarations }
doDrawing, doEntity, doLayer, doSymbol, doView, doDetail : boolean;
end;
var
atrForm : TatrForm;
implementation
uses
UConstants, UInterfaces, UInterfacesRecords, URecords, UVariables;
{$R *.dfm}
procedure TatrForm.FormShow(Sender : TObject);
type
TFillProp = packed record
FillClr,
PatternClr: integer;
FillPattern: smallint;
dobmp,
DoEntFillClr,
DoEntPatternClr,
ImgFixAspect: boolean;
ImageName: Str255;
end;
var
AtrName : string;
atr : attrib;
AtrAddr, EntAddr, LyrAddr, SymAddr, VueAddr, DtlAddr : lgl_addr;
atrString : string;
ent : entity;
//lyr : lgl_addr;
layer : Rlayer;
sym : sym_type;
mode : mode_type;
SL : TStringList;
FillProp : TFillProp;
Vue : view_type;
begin
if doDrawing then begin
//Get Drawing Attributes
AtrAddr := atr_sysfirst;
while atr_get(atr, AtrAddr) do begin
AtrName := atr.Name;
if AtrName = 'DC_FILL' then begin
move(atr.shstr, FillProp, length(atr.shstr));
ValueListEditor1.InsertRow('Drawing: Fill Color - ' +
AtrName, IntToStr(FillProp.FillClr), True);
ValueListEditor1.InsertRow('Drawing: Pattern Color - ' +
AtrName, IntToStr(FillProp.PatternClr), True);
ValueListEditor1.InsertRow('Drawing: Fill Pattern - ' +
AtrName, IntToStr(FillProp.FillPattern), True);
ValueListEditor1.InsertRow('Drawing: Bitmap Fill - ' +
AtrName, BoolToStr(FillProp.dobmp, True), True);
ValueListEditor1.InsertRow('Drawing: Fill Color = Entity - ' +
AtrName, BoolToStr(FillProp.DoEntFillClr, True), True);
ValueListEditor1.InsertRow('Drawing: Pattern Color = Entity - ' +
AtrName, BoolToStr(FillProp.DoEntPatternClr, True), True);
ValueListEditor1.InsertRow('Drawing: Fixed Image Aspect - ' +
AtrName, BoolToStr(FillProp.ImgFixAspect, True), True);
ValueListEditor1.InsertRow('Drawing: Bitmap Fill Name - ' +
AtrName, FillProp.ImageName, True);
end
else if atr.atrtype = atr_int then atrString := IntToStr(atr.int)
else if atr.atrtype = atr_str then atrString := (atr.str)
else if atr.atrtype = atr_dis then atrString := FloatToStr(atr.dis)
else if atr.atrtype = atr_ang then atrString := FloatToStr(atr.ang)
else if atr.atrtype = atr_pnt then atrString :=
'x: ' + FloatToStr(atr.pnt.x) + ' y: ' + FloatToStr(atr.pnt.x) +
' z: ' + FloatToStr(atr.pnt.x)
else if atr.atrtype = atr_str255 then atrString := (atr.shstr);
AtrAddr := atr.Next; // atr_next(atr);
ValueListEditor1.InsertRow('Drawing: ' + AtrName, atrString, True);
end;
end;
if doEntity then begin
// Get Entity Attributes
mode_init(mode);
mode_lyr(mode, lyr_all); // Search all layers
EntAddr := ent_first(mode);
while ent_get(ent, EntAddr) do begin
AtrAddr := ent.frstatr; // atr_entfirst(ent);
EntAddr := ent_next(ent, mode);
while atr_get(atr, AtrAddr) do begin
AtrName := atr.Name;
if AtrName = 'DC_FILL' then begin
move(atr.shstr, FillProp, length(atr.shstr));
ValueListEditor1.InsertRow('Entity: Fill Color - ' +
AtrName, IntToStr(FillProp.FillClr), True);
ValueListEditor1.InsertRow('Entity: Pattern Color - ' +
AtrName, IntToStr(FillProp.PatternClr), True);
ValueListEditor1.InsertRow('Entity: Fill Pattern - ' +
AtrName, IntToStr(FillProp.FillPattern), True);
ValueListEditor1.InsertRow('Entity: Bitmap Fill - ' +
AtrName, BoolToStr(FillProp.dobmp, True), True);
ValueListEditor1.InsertRow('Entity: Fill Color = Entity - ' +
AtrName, BoolToStr(FillProp.DoEntFillClr, True), True);
ValueListEditor1.InsertRow('Entity: Pattern Color = Entity - ' +
AtrName, BoolToStr(FillProp.DoEntPatternClr, True), True);
ValueListEditor1.InsertRow('Entity: Fixed Image Aspect - ' +
AtrName, BoolToStr(FillProp.ImgFixAspect, True), True);
ValueListEditor1.InsertRow('Entity: Bitmap Fill Name - ' +
AtrName, FillProp.ImageName, True);
end
else begin
if atr.atrtype = atr_int then atrString := IntToStr(atr.int)
else if atr.atrtype = atr_str then atrString := (atr.str)
else if atr.atrtype = atr_dis then
atrString := FloatToStr(atr.dis)
else if atr.atrtype = atr_ang then
atrString := FloatToStr(atr.ang)
else if atr.atrtype = atr_pnt then atrString :=
'x: ' + FloatToStr(atr.pnt.x) + ' y: ' +
FloatToStr(atr.pnt.x) + ' z: ' + FloatToStr(atr.pnt.x)
else if atr.atrtype = atr_str255 then atrString := (atr.shstr);
ValueListEditor1.InsertRow('Entity: ' + AtrName, atrString, True);
end;
AtrAddr := atr.Next; // atr_next(atr);
end;
end;
end;
if doLayer then begin
// Get Layer Attributes
LyrAddr := lyr_first;
while lyr_get(LyrAddr, layer) do begin
AtrAddr := layer.frstatr;
LyrAddr := layer.nxt; // lyr_next(LyrAddr);
while atr_get(atr, AtrAddr) do begin
AtrName := atr.Name;
if atr.atrtype = atr_int then atrString := IntToStr(atr.int)
else if atr.atrtype = atr_str then atrString := (atr.str)
else if atr.atrtype = atr_dis then atrString := FloatToStr(atr.dis)
else if atr.atrtype = atr_ang then atrString := FloatToStr(atr.ang)
else if atr.atrtype = atr_pnt then atrString :=
'x: ' + FloatToStr(atr.pnt.x) + ' y: ' + FloatToStr(atr.pnt.x) +
' z: ' + FloatToStr(atr.pnt.x)
else if atr.atrtype = atr_str255 then atrString := (atr.shstr);
AtrAddr := atr.Next; // atr_next(atr);
ValueListEditor1.InsertRow('Layer: ' { + layer.name } +
AtrName, atrString, True);
end;
end;
end;
if doSymbol then begin
// Get Symbol Attributes
SymAddr := sym_first;
while sym_get(sym, SymAddr) do begin
AtrAddr := sym.frstatr;
SymAddr := sym.Next;
while atr_get(atr, AtrAddr) do begin
AtrName := atr.Name;
if atr.atrtype = atr_int then atrString := IntToStr(atr.int)
else if atr.atrtype = atr_str then atrString := (atr.str)
else if atr.atrtype = atr_dis then atrString := FloatToStr(atr.dis)
else if atr.atrtype = atr_ang then atrString := FloatToStr(atr.ang)
else if atr.atrtype = atr_pnt then atrString :=
'x: ' + FloatToStr(atr.pnt.x) + ' y: ' + FloatToStr(atr.pnt.x) +
' z: ' + FloatToStr(atr.pnt.x)
else if atr.atrtype = atr_str255 then atrString := (atr.shstr);
AtrAddr := atr.Next; // atr_next(atr);
ValueListEditor1.InsertRow('Symbol: ' + AtrName, atrString, True);
end;
end;
end;
if doView then begin
VueAddr := PGSv.strtview;
// Get GoTo View Attributes
while view_get(Vue, VueAddr) do begin
AtrAddr := Vue.frstatr;
VueAddr := Vue.Next;
while atr_get(atr, AtrAddr) do begin
AtrAddr := atr.Next; // atr_next(atr);
if Vue.flag1 = 0 then begin
AtrName := atr.Name;
if atr.atrtype = atr_int then atrString := IntToStr(atr.int)
else if atr.atrtype = atr_str then atrString := (atr.str)
else if atr.atrtype = atr_dis then atrString := FloatToStr(atr.dis)
else if atr.atrtype = atr_ang then atrString := FloatToStr(atr.ang)
else if atr.atrtype = atr_pnt then atrString :=
'x: ' + FloatToStr(atr.pnt.x) + ' y: ' +
FloatToStr(atr.pnt.x) + ' z: ' + FloatToStr(atr.pnt.x)
else if atr.atrtype = atr_str255 then atrString := (atr.shstr);
ValueListEditor1.InsertRow('GoTo View: ' + AtrName, atrString, True);
end;
end;
end;
end;
if doDetail then begin
DtlAddr := PGSv.strtview;
// Get MSP Detail Attributes
while view_get(Vue, DtlAddr) do begin
AtrAddr := Vue.frstatr;
DtlAddr := Vue.Next;
while atr_get(atr, AtrAddr) do begin
AtrAddr := atr.Next; // atr_next(atr);
if Vue.flag1 = 1 then begin // flag2 contains sheet no.
AtrName := atr.Name;
if atr.atrtype = atr_int then atrString := IntToStr(atr.int)
else if atr.atrtype = atr_str then atrString := (atr.str)
else if atr.atrtype = atr_dis then atrString := FloatToStr(atr.dis)
else if atr.atrtype = atr_ang then atrString := FloatToStr(atr.ang)
else if atr.atrtype = atr_pnt then atrString :=
'x: ' + FloatToStr(atr.pnt.x) + ' y: ' +
FloatToStr(atr.pnt.x) + ' z: ' + FloatToStr(atr.pnt.x)
else if atr.atrtype = atr_str255 then atrString := (atr.shstr);
ValueListEditor1.InsertRow('MSP Detail: ' + AtrName, atrString, True);
end;
end;
end;
end;
// Sort Value List
SL := TStringList.Create;
SL.Assign(ValueListEditor1.Strings);
SL.Sort;
ValueListEditor1.Strings := SL;
end;
end.