library McadxSw2021;
{$mode delphi}
{$H+}
{$INTERFACES COM}
{
This is a very basic Solidworks Addin DLL which connects with SW, makes a simple function call
using early binding and the SW type library to retrieve the SW version
and then sets up a command item and callback.
The special thing is that we do not have a type library of our own for the call backs
so we roll our own IDispatch with the critical four functions (GetIDsOfNames, Invoke, etc).
Note SW calls back with functions by name (late binding).
A further experiment will be to use RTTI to handle the GetIDsOfNames rather than the if else chain.
Configure the SW exe in Run Parameters so you can 'Run' the DLL which will start SW.
Use the Lazarus event viewer to view the output.
}
uses
Windows, Classes, SysUtils, ComObj, ActiveX, ComServ, Variants,
//SysUtils, ComObj, ComServ, ActiveX, jwaWindows,
SldWorks_29_0_TLB,
SWPublished_29_0_TLB
;
const
cSwTargetRelease = '2021';
cProductTitleToRegister = 'MCADX Modeler';
CLASS_McadxSw2021Addin: TGUID = '{000161BE-9C4D-41CF-AA8B-0FFED4698D15}';
type
// keep GUID same as Delphi addin to avoid having to register this dll
IMcadxSw2021Addin = interface(IDispatch)
['{EE088A31-C162-416C-AC35-9F8F337C35F5}']
procedure ShowMessageCommand; safecall;
function EnableCommand:integer; safecall;
end;
{ TMcadxSw2021Addin }
TMcadxSw2021Addin = class(TComObject, IMcadxSw2021Addin, ISwAddin, IDispatch, IUnknown)
private
FSWApp: ISldWorks;
FCmdManager: ICommandManager;
procedure CreateCommands;
procedure ShowMessageCommand; safecall; // can be private as our Dispatch mechanism will call
function EnableCommand:integer; safecall; // ditto
public
function ConnectToSW(ThisSW: IDispatch; Cookie: Integer): HResult; stdcall;
function DisconnectFromSW: HResult; stdcall;
// roll our own IDispatch handling as we do not have a type library and only have a couple of commands to handle
// in this proof of concept
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: TDispID; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
function GetTypeInfoCount(out Count: Longint): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
end;
CoMcadxSw2021Addin = class
class function Create: IMcadxSw2021Addin;
class function CreateRemote(const MachineName: string): IMcadxSw2021Addin;
end;
TMcadxSw2021AddinFactory = class(TAutoObjectFactory)
public
procedure UpdateRegistry(Register: boolean); override;
end;
class function CoMcadxSw2021Addin.Create: IMcadxSw2021Addin;
begin
Result := CreateComObject(CLASS_McadxSw2021Addin) as IMcadxSw2021Addin;
end;
class function CoMcadxSw2021Addin.CreateRemote(const MachineName: string): IMcadxSw2021Addin;
begin
Result := CreateRemoteComObject(MachineName, CLASS_McadxSw2021Addin) as IMcadxSw2021Addin;
end;
// adapted from Claude and Gemini generated code
function TMcadxSw2021Addin.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
type
PPOleStrArray = ^TPOleStrArray;
TPOleStrArray = array[0..0] of LPOleStr;
PDISPIDArray = ^TDISPIDArray;
TDISPIDArray = array[0..0] of TDispID;
var
NamesArray: PPOleStrArray;
IDsArray: PDISPIDArray;
i: Integer;
begin
OutputDebugStringW(PWideChar('GetIDsOfNames called!'));
NamesArray := PPOleStrArray(Names);
IDsArray := PDISPIDArray(DispIDs);
Result := S_OK;
// think about using RTTI to avoid this if else chain
for i := 0 to NameCount - 1 do
begin
// Convert PWideChar to string and match
if SameText(WideString(NamesArray^[i]), 'ShowMessageCommand') then
IDsArray^[i] := 1
else
if SameText(WideString(NamesArray^[i]), 'EnableCommand') then
IDsArray^[i] := 2
else
IDsArray^[i] := DISPID_UNKNOWN;
end;
end;
function TMcadxSw2021Addin.Invoke(DispID: TDispID; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
begin
OutputDebugString(PChar('Invoke called!'));
case DispID of
1: begin
OutputDebugString(PChar('menu item called back'));
ShowMessageCommand;
Result := S_OK;
end;
2: begin
OutputDebugString(PChar('enable menu item called back'));
PVariant(VarResult)^ := EnableCommand;
Result := S_OK;
end
else
OutputDebugString(PChar('Disp ID not found in invoke'));
Result := DISP_E_MEMBERNOTFOUND;
end;
end;
function TMcadxSw2021Addin.GetTypeInfoCount(out Count: Longint): HResult; stdcall;
begin
Count := 0; // no type lib/info
Result := S_OK;
end;
function TMcadxSw2021Addin.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
begin
Result := E_NOTIMPL;
end;
{ notes from Claude when describing problem
(returning S_OK/0 from GetTypeInfoCount and E_NOTIMPL from GetTypeInfo is the standard "I don't support type-info
introspection, only name-based dispatch" pattern — fine here since SolidWorks only needs GetIDsOfNames/Invoke.)
Wire that in, add IDispatch to your class's declared interfaces, click the menu item, and see if OnMenuItem1Click
actually fires. If it does, you've now validated the entire chain end-to-end: type library fidelity, COM DLL plumbing,
calls into SolidWorks, and callbacks from SolidWorks back into your code. At that point the migration risk picture
looks genuinely good — the remaining work is breadth (implementing more of the API surface you actually use),
not a new category of unknown.
Worth noting: this same IDispatch requirement applies to the modern ICommandManager/AddCommandItem2 UI path too, and to
event sinks (document/part events) if you use those — so solving it once here pays off across the rest of the add-in.
}
// end from Claude
function TMcadxSw2021Addin.ConnectToSW(ThisSW: IDispatch; Cookie: Integer): HResult; stdcall;
var
base, curr: WideString;
begin
try
FSWApp := ThisSW as ISldWorks;
OutputDebugString(PChar('Connected to Sw application interface'));
except
on e: exception do
OutputDebugString(PChar('Exception getting Sw application interface ' + e.Message));
end;
// test that we can call a function on SW (using SW type lib and dispinterface)
FSWApp.GetBuildNumbers(base, curr);
OutputDebugStringW(PWideChar('SW Build numbers=' + base + ' ' + curr));
try
// Set up callbacks linking back to this object instance
FSWApp.SetAddinCallbackInfo2(HInstance, Self as IDispatch, Cookie); // HInstance or 0 also ok
except
on e: exception do
OutputDebugString(PChar('Failed to setup callback info ' + e.Message));
end;
try
FCmdManager := FSwApp.GetCommandManager(Cookie);
if Assigned(FCmdManager) then
begin
OutputDebugString('Successfully retrieved ICommandManager.');
CreateCommands; // add a single command
end
else
OutputDebugString('Failed to retrieve ICommandManager.');
except
on e: exception do
OutputDebugString(PChar('Failed getting command manager ' + e.Message));
end;
Result := S_OK;
end;
function TMcadxSw2021Addin.DisconnectFromSW: HResult; stdcall;
begin
OutputDebugString(PChar('Disconnected from Sw application interface'));
Result := S_OK;
end;
procedure TMcadxSw2021Addin.CreateCommands;
const
swMenuItem = $00000001;
// swToolbarItem = $00000002;
var
CommandGroup: ICommandGroup;
Title: widestring;
Tooltip: widestring;
Hint: widestring;
Actn: widestring;
CallbackFunction: widestring;
EnableMethodCallback: widestring;
res: Integer;
wTrue, wFalse: WordBool;
begin
// ensure strings are COM compatible - probably unnecessary
Title := 'My Custom Commands';
Tooltip := 'My custom command group';
Hint := 'Performs custom actions in SolidWorks';
wTrue := True;
wFalse := False;
// 2. Create the Command Group
CommandGroup := FCmdManager.CreateCommandGroup(
1, // User-defined ID for this group
Title, Tooltip, Hint, -1
);
CommandGroup := FCmdManager.GetCommandGroup(1);
OutputDebugString('GetCommandGroup(1) succeeded');
if CommandGroup <> nil then
begin
CallbackFunction := 'ShowMessageCommand';
EnableMethodCallback := 'EnableCommand';
// 3. Add a command item
actn := 'My Action';
hint := 'Executes my custom action';
tooltip := 'My Action Tooltip';
res := CommandGroup.AddCommandItem2(
actn, // 'My Action',
0, // Menu Position
hint, // 'Executes my custom action',
tooltip, // 'My Action Tooltip',
0,
CallbackFunction,
EnableMethodCallback,
1, // User ID
swMenuItem // or swToolbarItem
);
OutputDebugString(PChar('AddCommandItem succeeded ' + IntToStr(res)));
// Activate the command group and make it visible
CommandGroup.HasToolbar := wFalse;
CommandGroup.HasMenu := wTrue;
CommandGroup.Activate;
OutputDebugString('state setting succeeded'); // menu appears
end;
end;
procedure TMcadxSw2021Addin.ShowMessageCommand; safecall;
begin
OutputDebugString(PChar('Hello from Test menu item'));
end;
function TMcadxSw2021Addin.EnableCommand:integer; safecall;
begin
OutputDebugStringW(PWideChar('enable called'));
result := 1; // 0 to disable the command
end;
procedure TMcadxSw2021AddinFactory.UpdateRegistry(Register: boolean);
const
cSwAddinRegFolder = 'SOFTWARE\SolidWorks\SOLIDWORKS ' + cSwTargetRelease + '\Addins\';
var
AppClassID: string;
begin
AppClassID := GUIDToString(CLASS_McadxSw2021Addin);
if Register then
begin
inherited UpdateRegistry(Register);
CreateRegKey(cSwAddinRegFolder + AppClassID, '', '1', HKEY_LOCAL_MACHINE);
CreateRegKey(cSwAddinRegFolder + AppClassID, 'Description', cProductTitleToRegister + ' for ' + 'Sw' + cSwTargetRelease, HKEY_LOCAL_MACHINE);
CreateRegKey(cSwAddinRegFolder + AppClassID, 'Title', cProductTitleToRegister, HKEY_LOCAL_MACHINE);
OutputDebugString(PChar('created registry keys (called unexpectedly as should already be registered!)'));
end
else
begin
DeleteRegKey(cSwAddinRegFolder + AppClassID, HKEY_LOCAL_MACHINE);
inherited UpdateRegistry(Register);
OutputDebugString(PChar('deleted registry keys (unexpectedly!)'));
end;
end;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
initialization
OutputDebugString(PChar('about to create addin'));
TComObjectFactory.Create(ComServer, TMcadxSw2021Addin, Class_McadxSw2021Addin, 'SwAddin', 'FP Add in', ciMultiInstance, tmApartment);
OutputDebugString(PChar('created addin?'));
end.
Recent
