u_solidwork.pas

来自「写了一个获取SolidWorks文件结构的代码。以XML开式输出。」· PAS 代码 · 共 97 行

//
//  读取SolidWorks的类
//  张河阳  2007-4-20
unit u_SolidWork;

interface

uses ComObj,Dialogs,xmldom, XMLIntf, msxmldom, XMLDoc,SysUtils,u_3DFile;


Type TSolidWorks=class(T3DFile)
  private
    function IsAssembleFile(Filename: string): boolean;
    function GetSolidWorksSub(FileName: string; swapp: variant;ParentNode:IXMLNode): boolean;overload;
    function GetSolidWorksSub(filename:string):boolean;overload;
  protected
  public
     function OutputXML: boolean;override;
  published

end;


implementation

{ SolidWorks }
function TSolidWorks.IsAssembleFile(Filename: string): boolean;
var docname:string;
begin
  docname:=lowercase(extractfileName(Filename));
  if pos('.sldasm',docname)>0 then result:=True
                              else Result:=false;
end;

function TSolidWorks.GetSolidWorksSub(FileName:string;swapp:variant;ParentNode:IXMLNode):boolean;
var FileObj:variant;
    I,FileCount:integer;
    str:string;
    anode:IXMLNode;
begin
  result:=True;
  try
    Filecount:=swapp.GetDocumentDependenciesCount(filename,False,True);
    if Filecount=0 then //下层没有子女
    begin
      result:=True;
      Exit;
    end;
    Fileobj:=swapp.GetDocumentDependencies(filename,False,true);
    for I:=0 to Filecount-1 do
    begin
      if i mod 2=0 then continue;    //只取路径
      str:= FileObj[I];
      anode:=self.ADDXMLNode(ParentNode,FileObj[I]);
      {加入下层组成}
      if IsAssemblefile(str) then
      begin
        if not GetSolidWorksSub(str,swapp,anode) then
          Raise Exception.Create('Error');
      end;
    end;
  except
    result:=False;
  end;
end;
function TSolidWorks.GetSolidWorksSub(filename:string):boolean;
var swapp:variant;
anode:IXMLNode;
begin
  result:=True;
  try
    swapp:=CreateOleObject('SldWorks.Application');
  except
    result:=false;
    //ShowMessage('您的机器上没有安装SolidWorks软件,无法获取结构');
  end;
  try
    anode:=self.ADDXMLNode(nil,filename);
    result:=GetSolidWorksSub(filename,swapp,anode);
    swapp.ExitApp;
  finally

  end;
end;




function TSolidWorks.OutputXML: boolean;
begin
  result:=false;
  if  GetSolidWorksSub(FFileName) then
    result:=inherited OutputXML;
end;

end.