The DataCAD Developer Network (DDN) is an online resource for information and support for DCAL® (DataCAD Applications Language) developers as well as anyone interested in creating fonts, toolbars, hatch patterns, or linetypes for use in DataCAD.
#50986 by Mark F. Madura
Wed Nov 10, 2010 5:04 pm
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':
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 allunit 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.

Who is online

Users browsing this forum: No registered users and 10 guests

About DataCAD Forum

The DataCAD Forum is a FREE online community we provide to enhance your experience with DataCAD.

We hope you'll visit often to get answers, share ideas, and interact with other DataCAD users around the world.

DataCAD

Software for Architects Since 1984