ARES, AutoCAD, BricsCAD, IJCAD, ZWCAD ほぼ対応版を追加しました (2023/08/28)
ExcelToCAD.exe 2023/02/04
ExcelToACAD23.exe 2023/02/11
ExcelToBCAD23.exe 2023/02/11
ExcelToIJCAD23.exe 2023/02/11
「とりあえず、Excel のデータを CAD に取り込みたい!」 ために作りました。
ExcelToCAD.exe は Bricscad V19、Autocad (LT) で使えます。
他の exe はそれぞれの CAD 専用です。
作成される DXF ファイルは、他の CAD でも読み込み可能です。
・2023/02/11 AutoCAD, BricsCAD, IJCAD 専用版を追加。
・2023/02/04 Excel のバージョン番号指定バージョン。バージョン番号が ".14" 固定になっていたのを修正しました。
・2023/02/02 Excel 64bit 版で動くかもしれないバージョン。
・2018/12/22 文字基点、文字高さ、列幅、行高さの個別変更を追加。
・2018/12/16.2 エクセルからの取り込みに失敗したとき、作成ボタンが押せないようにした。
・2018/12/16.1 フォームのグリッド内の文字表示位置を取得した文字位置に合わせるに変更。
・2018/12/16 名前を変更。罫線に対応。文字列変換を追加。作成画層分けに変更。
・2018/12/14 斜め罫線の描画を追加。CAD への描画を DXF ファイル挿入に変更し、Autocad / LT に対応。
・2018/12/12 文字高さを反映。結合セルにかかる線分を描かないようにしました。
予め、エクセルで取得範囲を選択しておく必要があります。
エクセルから取得後、Bricscad、Autocad (LT) に文字列とセルの区切り線分、罫線を描画します。
Bricscad V17, V19 / Autocad LT 2019 + Excel2010 にて、動作を確認しました。
ExcelToCAD.exe と同じフォルダに ExcelToCAD.dxf を作成し、このファイルを対象の CAD へ挿入しています。
対象の CAD が見つからない場合でもファイルは作成されます。
文字高さ、列幅、行高さの個別変更は、予め範囲を選択しておき、数値を変更後 [Enter]キーを押します。
文字基点は、[左] [中] [右] ボタンを押します。
※予め対象の範囲を選択しておいてください。固定部分のクリックか、[Shift] + 矢印キーで複数セルが選択できます。
エクセルから取り込んだ文字列の変換が行えます。
(マウス右クリックでポップアップメニューが出ます)
・半角→全角
・半角→全角(英数字のみの文字列を除く)
・全角→半角
・全角数字→半角
・全角アルファベット→半角
・半角カタカナ→全角
・代替文字を含む禁止文字→半角
・置換
※予め対象の範囲を選択しておいてください。固定部分のクリックか、[Shift] + 矢印キーで複数セルが選択できます。
取り込み時の尺度は、ここで変更できます。
※個別に変更した文字高さ、文字基点、列幅、行高さはリセット(再計算)されます。
■取得前に、エクセルで予め範囲を選択しておきます。
■対象 CAD では、下記の画層が作成されます
・文字列: ExcelCellText 画層 色番号 = 256 (BYLAYER)
・セルの区切り線: ExcelCellLine 画層で 色番号 = 252 (グレイ)
・罫線: ExcelBordLine 画層 色番号 = 256 (BYLAYER)
■ダウンロード
最新版: ARES, AutoCAD, BricsCAD, IJCAD, ZWCAD にほぼ対応 (2023/08/28)
http://www.izawa-web.com/zip/ExcelToCADX20230813.zip
2023/02/04 下記、いずれも Excel for Microsoft 365 (64bit版) にて、動作を確認しています。
ExcelToCAD.zip (2018.12.22 EXE 本体のみ Bricscad V19 まで, Autocad (LT) 2023 まで対応版)
・Excel 64bit 版で動くかもしれないバージョン
ExcelToCAD230202.zip (2023.02.02 EXE 本体のみ Bricscad V19 まで, Autocad (LT) 2023 まで対応版)
・Excel のバージョン番号を ini ファイルで指定するバージョン。バージョン番号が ".14" 固定になっていたのを修正しました。
自動で作成される ini ファイルの xlsVerNum=16 の数値を変更してください。14=Excel 2010, 15=Excel
2013, 16=Excel 2016~2023
ExcelToCAD230204.zip (2023.02.04 64bit 版EXE 本体のみ Bricscad V19 まで, Autocad (LT) 2023 まで対応版)
ExcelToACAD23.zip (2023.02.11 64bit 版EXE 本体のみ for AutoCAD ~2023 LT では動きません)
ExcelToBCAD23.zip (2023.02.11 64bit 版EXE 本体のみ for BricsCAD ~V23)
ExcelToIJCAD23.zip (2023.02.11 64bit 版EXE 本体のみ for IJCAD ~2023 LT では動きません)
※2018/12/12 時点のコードを一部修正 (range.Value2 -> range.Text)
・DXFファイル作成版ではありません。
・タイプライブラリの取り込みが必要です。
// 2018/12/11 初版 // 2018/12/11a 結合セルの幅、高さの取得を追加 // 2018/12/12 文字高さを反映、結合セル内は線分を描かないを追加 unit Unit2; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, {XlsxCrtApi,} Vcl.StdCtrls, Vcl.Grids, Math, BricscadApp_TLB, BricscadDb_TLB, ComObj, Excel_TLB, Vcl.ComCtrls, Vcl.ExtCtrls, IniFiles; type TXlsxCellAttr = record rowH, colW : Word; // セルの高さ、幅 txtSize : Word; // 文字高さ txtAlign : Byte; // 文字位置(水平位置) str : string; // 文字列 lineBits : Byte; // 罫線 cellMerge : boolean; // 結合されている mergeRowsCount : Word;// 結合セルの行数 mergeColsCount : Word;// 結合セルの列数 mergeLeft, mergeTop : Word; // 結合セルの左上の座標(未使用) mergeW, mergeH : Word; // 結合されたセルの大きさ(集計値) mark : boolean; // 集計済マーク end; type TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; OpenDialog1: TOpenDialog; Panel1: TPanel; Label3: TLabel; Label6: TLabel; Label5: TLabel; Label4: TLabel; Label1: TLabel; Edit3: TEdit; Label2: TLabel; Edit2: TEdit; Button3: TButton; Button2: TButton; CheckBox1: TCheckBox; Edit1: TEdit; Panel2: TPanel; StringGrid1: TStringGrid; GroupBox1: TGroupBox; Label7: TLabel; Label8: TLabel; GroupBox2: TGroupBox; Label15: TLabel; Label16: TLabel; Label17: TLabel; Label18: TLabel; Edit4: TEdit; Edit5: TEdit; Edit6: TEdit; Edit7: TEdit; Edit8: TEdit; Edit9: TEdit; Button1: TButton; procedure StringGrid1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure Button1Click(Sender: TObject); private { Private 宣言 } public { Public 宣言 } // StringGrid への尺度 colSc ,rowSc : double; // Bricscad への尺度 cadXsc, cadYsc : double; // TEXT 作成の尺度 cadTsc : double; // 文字基点のオフセット(行高さ * cadTof) cadTof : double; end; var Form1: TForm1; XlsxCellAry : array of TXlsxCellAttr; XlsxColCount : integer; XlsxRowCount : integer; implementation {$R *.dfm} function XlsCellStrToPos(const A1:string; var col: integer; var row: integer): boolean; // 'B1' を 1,0 に変換 // 0ベースなので注意 var s, s1, s2 : string; i,j : integer; begin s := Uppercase(A1); s1 := ''; s2 := ''; for i := 1 to Length(s) do begin if (Ord(s[i]) >= 48) and (Ord(s[i]) <= 57) then s2 := s2 + s[i] else if (Ord(s[i]) >= 65) and (Ord(s[i]) <= 90) then s1 := s1 + s[i]; end; // 0 ベース エラー時-1 row := StrToIntDef(s2, 0) -1; if s1 <> '' then begin j := 0; col := 0; for i := Length(s1) downto 1 do begin col := col + (Ord(s1[i])-64) * Trunc(Power(26, j)); Inc(j); end; col := col - 1; end; result := (col >= 0) and (row >= 0); end; function XlsColToStr(col : integer): string; // 1から始まる列番号をアルファベットの列番号に変換 var k, n, m : integer; begin result := ''; k := col; if k > 0 then begin while True do begin m := k mod 26; n := k div 26; if (m = 0) and (n >= 0) then begin m := 26; n := n - 1; end; result := Char(64 + m) + result; k := n; if n <= 0 then break; end; end; end; procedure CheckMergeWH; // セル結合の幅、高さを計算 // mergeW > 0 and mergeH > の時、そのセルは、結合セルの左上である // 結合セルの左上以外は、mark = True になる var i, j, k,l, n, m : integer; w, h : integer; begin if Length(XlsxCellAry) > 0 then begin for i := 0 to XlsxRowCount -1 do begin for j := 0 to XlsxColCount -1 do begin with XlsxCellAry[i * XlsXColCount + j] do begin if not mark and cellMerge then begin n := mergeColsCount; m := mergeRowsCount; w := colW; h := rowH; if n > 1 then begin for k := 1 to n - 1 do begin w := w + XlsxCellAry[i * XlsXColCount + j + k].colW; XlsxCellAry[i * XlsXColCount + j+k].mark := True; end; end; mergeW := w; if m > 1 then begin mark := True; for k := 1 to m - 1 do begin h := h + XlsxCellAry[(i + k) * XlsXColCount + j].rowH; XlsxCellAry[(i + k) * XlsXColCount + j].mark := True; if n > 1 then begin for l := 1 to n - 1 do XlsxCellAry[(i + k) * XlsXColCount + j+l].mark := True; end; end; end; mergeH := h; end; end; end; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin colSc := StrToFloatDef(Edit4.Text, 20.0); rowSc := StrToFloatDef(Edit5.Text, 3.0); cadXSc := StrToFloatDef(Edit6.Text, 10.0); cadYSc := StrToFloatDef(Edit7.Text, 1.5); cadTsc := StrToFloatDef(Edit8.Text, 0.8); cadTof := StrToFloatDef(Edit9.Text, 0.4); end; procedure TForm1.Button2Click(Sender: TObject); var app: BricscadApp_TLB.IAcadApplication; doc: IAcadDocument; mspc: IAcadModelSpace; txtEnt : IAcadText; lwpEnt : IAcadLwPolyline; lineEnt : IAcadLine; pt : OleVariant; pt1, pt2 : OleVariant; i : integer; w, h : integer; j : integer; ww, hh : integer; rectpt : OleVariant; cnt, cntMax : integer; stpt, edpt : OleVariant; yy, xx : double; markold : boolean; marknow : boolean; begin if FindWindow('BricscadMainWindow', nil) = 0 then exit; app := GetActiveOleObject('BricscadApp.AcadApplication') as IACadApplication; try stpt := VarArrayCreate([0, 2], VarDouble); edpt := stpt; rectpt := VarArrayCreate([0, 7], VarDouble); pt1 := VarArrayCreate([0, 2], VarDouble); pt2 := pt1; doc := app.ActiveDocument; mspc := doc.ModelSpace; SetForegroundWindow(app.HWND_); try app.RunCommand('^C'); pt := doc.Utility.GetPoint(EmptyParam, #13+'作成点を指示 : '); doc.StartUndoMark; doc.Utility.Prompt('作成中 ...'); stpt := pt; edpt := pt; with StringGrid1 do begin w := 0; h := 0; for i := 1 to ColCount -1 do w := w + XlsxCellAry[(i -1)].colW; for i := 1 to RowCount -1 do h := h + XlsxCellAry[(i -1) * XlsXColCount].rowH; if not CheckBox1.Checked then begin // 横罫線 edpt[0] := pt[0] + w * cadXsc; for i := 1 to RowCount -1 do begin xx := 0; markold := true; for j := 1 to ColCount -1 do begin marknow := XlsxCellAry[(j -1) + (i -1) * XlsXColCount].cellMerge; if not markold and marknow then begin edpt[0] := pt[0] + xx; lineEnt := mspc.AddLine(stpt, edpt); end else if markold and not marknow then begin stpt[0] := pt[0] + xx; end; markold := marknow; // 原点から右への偏差 xx := xx + XlsxCellAry[(j -1) + (i -1) * XlsXColCount].colW * cadXsc; end; if not markold then edpt[0]:= pt[0] + w * cadXsc; lineEnt := mspc.AddLine(stpt, edpt); stpt[1] := stpt[1] - XlsxCellAry[(i -1) * XlsXColCount].rowH * cadYsc; edpt[1] := stpt[1]; end; lineEnt := mspc.AddLine(stpt, edpt); // 縦罫線 stpt := pt; edpt := pt; edpt[1] := pt[1] - h * cadYsc; for j := 1 to ColCount -1 do begin yy := 0; markold := true; for i := 1 to RowCount -1 do begin marknow := XlsxCellAry[(j -1) + (i -1) * XlsXColCount].cellMerge; if not markold and marknow then begin edpt[1] := pt[1] - yy; lineEnt := mspc.AddLine(stpt, edpt); end else if markold and not marknow then begin stpt[1] := pt[1] - yy; end; markold := marknow; // 原点から下への偏差 yy := yy + XlsxCellAry[(j -1) + (i -1) * XlsXColCount].rowH * cadYsc; end; if not markold then edpt[1]:= pt[1] - h * cadYsc; lineEnt := mspc.AddLine(stpt, edpt); stpt[0] := stpt[0] + XlsxCellAry[(j -1)].colW * cadXsc; edpt[0] := stpt[0]; end; lineEnt := mspc.AddLine(stpt, edpt); end; cnt := 1; cntMax := XlsXColCount * XlsXRowCount; // 文字列 pt1 := pt; for i := 1 to RowCount -1 do begin // 左下基点(これは動かさない) pt1[1] := pt1[1] - XlsxCellAry[(i -1) * XlsXColCount].rowH * cadYsc; // pt2: 文字の作成位置 pt2 := pt1; for j := 1 to ColCount -1 do begin Label4.Caption := cnt.ToString + ' / ' + cntMax.ToString; Inc(cnt); with XlsxCellAry[(i -1) * XlsXColCount + (j -1)] do begin // 結合セル if (mergeW > 0) and (mergeH > 0) then begin hh := mergeH; ww := mergeW; rectpt[0] := pt1[0]; rectpt[2] := pt1[0] + mergeW * cadXsc; rectpt[4] := rectpt[2]; rectpt[6] := rectpt[0]; rectpt[1] := pt1[1] + rowH * cadYsc; rectpt[3] := rectpt[1]; rectpt[5] := rectpt[1] - mergeH * cadYsc; rectpt[7] := rectpt[5]; if not CheckBox1.Checked then begin lwpEnt := mspc.AddLightWeightPolyline(rectpt); lwpEnt.Closed := True; lwpEnt.color := 4; end; end else begin hh := rowH; ww := colW; end; // 文字位置 X pt2[1] := pt1[1] + hh * cadYsc * 0.5; if (txtAlign = 2) then pt2[0] := pt1[0] + ww * cadXsc / 2 else if (txtAlign = 3) then pt2[0] := pt1[0] + ww * cadXsc - hh * cadYsc * cadTof else pt2[0] := pt1[0] + hh * cadYsc * cadTof; if Cells[j, i] <> '' then begin txtEnt := mspc.AddText(Cells[j, i], pt2, txtSize * cadTsc); if (txtAlign = 2) then // 「中中」に変更 txtEnt.Alignment := acAlignmentMiddleCenter else if (txtAlign = 3) then // 「右中」に変更 txtEnt.Alignment := acAlignmentMiddleRight else // 「左中」に変更 txtEnt.Alignment := acAlignmentMiddleLeft; // 基点を更新 txtEnt.TextAlignmentPoint := pt2; end; pt1[0] := pt1[0] + colW * cadXsc; end; end; pt1[0] := pt[0]; end; end; doc.EndUndoMark; doc.Utility.Prompt('終了しました.'); Label4.Caption := ''; app.RunCommand('^C'); except // MessageBox(Handle, 'キャンセル', '', 0); raise; end; except ; end; end; procedure TForm1.Button3Click(Sender: TObject); var excelApp : ExcelApplication; workSheet: ExcelWorksheet; range : ExcelRange; strow, stcol, edrow, edcol : integer; stadr, edadr, rng : string; i, j, sgrow, sgcol : integer; colW, rowH : integer; halign : Cardinal; temp : TXlsxCellAttr; begin if FindWindow('XLMAIN', nil) = 0 then exit; Button3.Enabled := False; excelApp := GetActiveOleObject('Excel.Application') as Excel_TLB.ExcelApplication; try workSheet := excelApp.ActiveSheet as ExcelWorksheet; Caption := excelApp.ActiveWorkbook.Name +' [' + workSheet.Name + ']'; // 選択中のセルを取得 range := excelApp.Selection[LCID] as ExcelRange; // 選択セルの左上 strow := range.Row; stcol := range.Column; // 選択セルの右下 edrow := range.Row + range.Rows.Count -1; edCol := range.Column + range.Columns.Count -1; // 'A1' 表示に stadr := XlsColToStr(stcol) + stRow.ToString; edadr := XlsColToStr(edcol) + edRow.ToString; // 選択範囲を表示 Edit2.Text := stadr; Edit3.Text := edadr; with StringGrid1 do begin ColWidths[0] := 70; RowCount := range.Rows.Count + 1; ColCount := range.Columns.Count + 1; SetLength(XlsxCellAry, range.Columns.Count * range.Rows.Count); XlsXColCount := ColCount-1; XlsXRowCount := RowCount-1; sgrow := 1; for i := strow to edrow do begin Label4.Caption := sgRow.ToString +' / ' + (RowCount-1).ToString; Cells[0, sgrow] := i.ToString; sgcol := 1; for j := stcol to edcol do begin rng := XlsColToStr(j) + i.ToString; range := workSheet.Range[rng, EmptyParam] as ExcelRange; colW := range.ColumnWidth; temp.colW := colW; if i = strow then begin // 列の幅 ColWidths[sgcol] := Trunc(colW * colsc); Cells[sgcol, 0] := XlsColToStr(j); end; rowH := range.RowHeight; temp.rowH := rowH; if j = stCol then begin // 行の高さ RowHeights[sgrow] := Trunc(rowH * rowsc); end; // 文字横位置の取得 halign := range.HorizontalAlignment; if (halign = xlSystem) or (halign = xlLeft) then temp.txtAlign := 1 else if (halign = xlCenter) then temp.txtAlign := 2 else if (halign = xlRight) then temp.txtAlign := 3 else temp.txtAlign := 0; // 文字高さ temp.txtSize := range.Font.Size; // 値を取得 Cells[sgcol, sgrow]:= range.Text;//Value2; temp.str := range.Text;//Value2; // 罫線 temp.lineBits := 0; if range.Borders[xlEdgeTop].LineStyle <> xlNone then temp.lineBits := temp.lineBits + 1; if range.Borders[xlEdgeBottom].LineStyle <> xlNone then temp.lineBits := temp.lineBits + 2; if range.Borders[xlEdgeLeft].LineStyle <> xlNone then temp.lineBits := temp.lineBits + 4; if range.Borders[xlEdgeRight].LineStyle <> xlNone then temp.lineBits := temp.lineBits + 8; // 右上がり斜線 if range.Borders[xlDiagonalDown].LineStyle <> xlNone then temp.lineBits := temp.lineBits + 16; // 右下がり斜線 if range.Borders[xlDiagonalUp].LineStyle <> xlNone then temp.lineBits := temp.lineBits + 32; // 結合されているか temp.cellMerge := range.MergeCells; temp.MergeRowsCount := range.MergeArea.Rows.Count; temp.MergeColsCount := range.MergeArea.Columns.Count; // 結合されているセルは、左、上の座標が結合エリアの左、上と同じ // mergeLeft, mergeTop の値が同じセルが結合されている temp.mergeLeft := range.MergeArea.Left; temp.mergeTop := range.MergeArea.Top; XlsxCellAry[(sgrow -1) * XlsXColCount + (sgcol -1)] := temp; Inc(sgcol); end; Inc(sgrow); end; // セル結合の幅、高さを計算 CheckMergeWH; end; excelApp := nil; MessageBox(Handle, '取得しました.', 'メッセージ', MB_OK{ or MB_ICONINFORMATION}); Label4.Caption := ''; except ; end; Button3.Enabled := True; end; procedure TForm1.Edit1Change(Sender: TObject); begin with StringGrid1 do begin if (Col >= 1) and (Row >= 1) then begin Cells[Col, Row] := Edit1.Text; end; end; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var ini : TIniFile; begin SetLength(XlsxCellAry, 0); ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')); try ini.WriteFloat('BcadTlsx', 'colSc', colSc); ini.WriteFloat('BcadTlsx', 'rowSc', rowSc); ini.WriteFloat('BcadTlsx', 'cadXsc', cadXSc); ini.WriteFloat('BcadTlsx', 'cadYsc', cadYSc); ini.WriteFloat('BcadTlsx', 'cadTsc', cadTsc); ini.WriteFloat('BcadTlsx', 'cadTof', cadTof); finally ini.Free; end; end; procedure TForm1.FormCreate(Sender: TObject); var ini : TIniFile; begin Edit1.Text := ''; Edit2.Text := ''; Edit3.Text := ''; Label4.Caption := ''; Label5.Caption := ''; Label6.Caption := ''; ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')); try colSc := ini.ReadFloat('BcadTlsx', 'colSc', 20.0); rowSc := ini.ReadFloat('BcadTlsx', 'rowSc', 3.0); cadXSc := ini.ReadFloat('BcadTlsx', 'cadXsc', 10.0); cadYSc := ini.ReadFloat('BcadTlsx', 'cadYsc', 1.5); cadTsc := ini.ReadFloat('BcadTlsx', 'cadTsc', 0.8); cadTof := ini.ReadFloat('BcadTlsx', 'cadTof', 0.4); Edit4.Text := FloatToStr(colSc); Edit5.Text := FloatToStr(rowSc); Edit6.Text := FloatToStr(cadXsc); Edit7.Text := FloatToStr(cadYsc); Edit8.Text := FloatToStr(cadTsc); Edit9.Text := FloatToStr(cadTof); finally ini.Free; end; end; procedure TForm1.StringGrid1Click(Sender: TObject); var s : string; begin s := ''; with StringGrid1 do begin Edit1.Text := Cells[Col, Row]; if Length(XlsxCellAry) > 0 then begin with XlsxCellAry[(Row -1) * XlsXColCount +(Col -1)] do begin s := '文字位置='; if txtAlign =2 then s := s + '中' else if txtAlign =3 then s := s + '右' else s := s+ '左'; s := s+ ' ,' + '結合='; if cellMerge then s := s + '有' else s := s+ '無'; s := s + mergeColsCount.ToString + ',' + mergeRowsCount.ToString; // 結合されているセルは、左、上の座標が結合エリアの左、上と同じ // mergeLeft, mergeTop の値が同じセルが結合されている s := s + '(' + mergeLeft.ToString + ',' + mergeTop.ToString + ')'; s := s + ' ,' + '罫線='; if lineBits and 1 > 0 then s := s + '上'; if lineBits and 2 > 0 then s := s + '下'; if lineBits and 4 > 0 then s := s + '左'; if lineBits and 8 > 0 then s := s + '右'; if lineBits and 16 > 0 then s := s + '右上'; if lineBits and 32 > 0 then s := s + '右下'; if lineBits =0 then s := s + '無'; Label4.Caption := s; Label5.Caption := Format('列幅=%d, 行高=%d',[colW, rowH]); if cellMerge then begin if not mark then s := '結合の左上 ' else s := '結合の左上以外 '; Label6.Caption := s + Format('結合幅=%d, 結合高=%d',[mergeW, mergeH]) end else Label6.Caption := ''; end; end; end; end; end.