Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4215 / 13644 ツリー ←次へ | 前へ→

【57783】任意の形状を図化するには? よう 08/9/13(土) 11:32 質問[未読]
【57784】Re:任意の形状を図化するには? かみちゃん 08/9/13(土) 11:42 発言[未読]
【57786】Re:任意の形状を図化するには? よう 08/9/13(土) 12:37 発言[未読]
【57789】Re:任意の形状を図化するには? みそじのおじさん 08/9/13(土) 13:02 発言[未読]
【57790】Re:任意の形状を図化するには? よう 08/9/13(土) 13:20 発言[未読]
【57793】Re:任意の形状を図化するには? みそじのおじさん 08/9/13(土) 15:06 発言[未読]
【57795】Re:任意の形状を図化するには? よう 08/9/13(土) 15:23 発言[未読]
【57798】Re:任意の形状を図化するには? みそじのおじさん 08/9/13(土) 16:09 発言[未読]
【57801】Re:任意の形状を図化するには? よう 08/9/13(土) 17:09 発言[未読]
【57830】Re:任意の形状を図化するには? よう 08/9/15(月) 19:58 発言[未読]
【57840】Re:任意の形状を図化するには? みそじのおじさん 08/9/16(火) 14:55 発言[未読]
【57843】Re:任意の形状を図化するには? よう 08/9/16(火) 23:34 お礼[未読]

【57783】任意の形状を図化するには?
質問  よう  - 08/9/13(土) 11:32 -

引用なし
パスワード
   お世話になります。

任意の形状、主に台形が多いのですが・・・

各辺長が、 A=10.1 B=1.3 C=9.5 D=1.8 の場合

A=10.1の線を描き、垂直にB=1.3、そこからC=9.5の円
、D=1.8の円を描き、接点を結んでいるのですが、たくさんの個数があり、また簡単な図のため、手間を省くため、エクセルで自動化できないかと思っています。


ネットで検索しても中々、見つかりません。


エクセルで入力し、SFC形式かDXF形式でCADへ変換できないものでしょうか?

【57784】Re:任意の形状を図化するには?
発言  かみちゃん  - 08/9/13(土) 11:42 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>任意の形状、主に台形が多いのですが・・・

任意の形状を図化という意味がよくわかりません。
グループ化しただけではいけないのでしょうか?

>エクセルで入力し、SFC形式かDXF形式でCADへ変換できないものでしょうか?

以下のようなツールを使う方法もあるかもしれません。

>> http://www.nifty.com/download/cgi-bin/vec_search.cgi?key=excel&dir_path=%2Fwin%2Fbusiness%2Fcad%2Fconv%2F&srch_max=30

【57786】Re:任意の形状を図化するには?
発言  よう  - 08/9/13(土) 12:37 -

引用なし
パスワード
   こんにちは、かみちゃんさん。

参考ツール、有難うございます。 変換はできそうなんですが、きちんとした長さでエクセルの方で処理できないかと思っています。

変換したCAD上で、すぐ手直しできるようにしたいのです。

宜しくお願いします。

【57789】Re:任意の形状を図化するには?
発言  みそじのおじさん  - 08/9/13(土) 13:02 -

引用なし
パスワード
   ▼よう さん:
みなさん、こんにちは。
私も、仕事でエクセルからDXFの変換作業をしています。(その逆もします。)
自動化は可能ですが、もう少し情報がなければできません。

1 シートのレイアウトはすでにあるのか、ないのか?
  (DXFにする場合、線の情報として始点のX.Y座標、終点のX.Y座標が必要です。
   Aの線でいえば、仮にX0,Y0を始点とすると、始点X0,Y0 終点X10.1,Y0とい
   う具合に個々のX.Y座標が必要です。DXFの単位はmmです。)

2 任意の図形を一つづつ個別のDXFファイルにしたいのか、そうではなくて
  任意の図形をまとめて1ファイルにするのかどうか?


>各辺長が、 A=10.1 B=1.3 C=9.5 D=1.8 の場合
>
>A=10.1の線を描き、垂直にB=1.3、そこからC=9.5の円
>、D=1.8の円を描き、接点を結ぶ

この接点を結ぶ作業はCADで行っているのか、計算をして結んでいるのかどうか?
(接線をかく作業は、CADでは簡単ですが計算をしてするとなると、多少複雑に
 なるかもしれません。)

実際の作業の流れを詳しく教えて頂ければ、お手伝いできるかもしれません。

【57790】Re:任意の形状を図化するには?
発言  よう  - 08/9/13(土) 13:20 -

引用なし
パスワード
   こんにちは、みそじのおじさんさん。

お仕事でエクセルからDXFの変換作業をされてるのですね!

仕事で今、舗装補修の図面を描いて面積を算出する作業を行っております。

一箇所当たりの面積は少ないのですが、補修箇所が数十箇所あるものですから、自動化ができないものだろうか・・・と思っておりました。

>1 シートのレイアウトはすでにあるのか、ないのか?
>  (DXFにする場合、線の情報として始点のX.Y座標、終点のX.Y座標が必要です。
>   Aの線でいえば、仮にX0,Y0を始点とすると、始点X0,Y0 終点X10.1,Y0とい
>   う具合に個々のX.Y座標が必要です。DXFの単位はmmです。)
>
ありません。ただ、各辺長から考えますと、
0,0
10.1,0
0,1.3
・・・
次がCADで描かないと分かりません。


>2 任意の図形を一つづつ個別のDXFファイルにしたいのか、そうではなくて
>  任意の図形をまとめて1ファイルにするのかどうか?

時間的には、大したことないため、一つづつ個別でもよいかと思っております。


>3
>>各辺長が、 A=10.1 B=1.3 C=9.5 D=1.8 の場合
>>
>>A=10.1の線を描き、垂直にB=1.3、そこからC=9.5の円
>>、D=1.8の円を描き、接点を結ぶ
>
>この接点を結ぶ作業はCADで行っているのか、計算をして結んでいるのかどうか?


接点を結ぶ作業はCAD上で結線して、円を消しております。


難しいことで大変、申し訳ございません。

【57793】Re:任意の形状を図化するには?
発言  みそじのおじさん  - 08/9/13(土) 15:06 -

引用なし
パスワード
   ▼よう さん:

ようさん、こんにちは。

>各辺長が、 A=10.1 B=1.3 C=9.5 D=1.8 の場合
>
>>A=10.1の線を描き、垂直にB=1.3、そこからC=9.5の円
>>、D=1.8の円を描き、接点を結ぶ


少し読み違いをしていたので形の確認をさせて下さい。
円Cの中心は、線Bの終点。円Dの中心は線Aの始点にある。
(これであっていますか?)

後、もう少し聞きたいことがありまして

1 この形以外のパターンもありますか?(入力点が4点ではなく、例えば五角形や六
  角形などでさらに作図の為に円を使うことがある)

2 お使いのCADは何でしょうか?(私はAutoCad2000i LTです。)

3 VBAの知識はありますでしょうか?(手直しする部分が結構でてくると思います。
  ようさんの環境にあわせて作動せるのに)


>難しいことで大変、申し訳ございません。

 いえいえ、私もこのサイトではいろいろお世話になっているもので、自分の分かる
 範囲でお力になれたらと(微力ですが...)


 

【57795】Re:任意の形状を図化するには?
発言  よう  - 08/9/13(土) 15:23 -

引用なし
パスワード
   みそじのおじさんさん、ありがとうございます。

>円Cの中心は、線Bの終点。円Dの中心は線Aの始点にある。
>(これであっていますか?)

これであっています


>
>後、もう少し聞きたいことがありまして
>
>1 この形以外のパターンもありますか?(入力点が4点ではなく、例えば五角形や六
>  角形などでさらに作図の為に円を使うことがある)


これ以外のパターンもあるのですが、入力が煩雑になるかと思いましたので、4点でよいです。


>
>2 お使いのCADは何でしょうか?(私はAutoCad2000i LTです。)

使っているCADは、JWCと土木CAD武蔵を使ってます。


>
>3 VBAの知識はありますでしょうか?


知識はほとんどありませんが、見ながら何と無くこうすればいいんだーと感じるくらいです。


申し訳ございません。もし、できれば宜しくお願いします。

【57798】Re:任意の形状を図化するには?
発言  みそじのおじさん  - 08/9/13(土) 16:09 -

引用なし
パスワード
   了解しました。

自宅にはPCがありませんので、連休明けとということで..申し訳ないです。

【57801】Re:任意の形状を図化するには?
発言  よう  - 08/9/13(土) 17:09 -

引用なし
パスワード
   いいえ〜 こちらこそ、申し訳ありません!!

【57830】Re:任意の形状を図化するには?
発言  よう  - 08/9/15(月) 19:58 -

引用なし
パスワード
   CADソフトの武蔵で、任意の形状を組み込めば、自動で絵を描いてくれる機能がありました。今日その形状を組み込んだところです。 解決です。色々、有難うございました。

【57840】Re:任意の形状を図化するには?
発言  みそじのおじさん  - 08/9/16(火) 14:55 -

引用なし
パスワード
   ようさん、こんにちは。
遅くなって申し訳ないです。解決したみたいですが
一応こんなやりかたもあるということで...

作業の流れとしては、DXFファイルはただのテキストファイルなので(正確にはバイナリ
ファイル)、テキストファイルにヘッダー部、線情報、フッター部(最低限この情報だけ
でDXFファイルは作成可能です。)を書き込み、拡張子を.dxfに変更して作成完了となり
ます。

標準モジュールにこれをコピーして下さい。

Option Explicit

'タイトル
Private Const CnsTitle = "DXF作成"

'色番号
Private Const ColorNo = 9 '使用するCADによって色番号が違う場合が
             'あるので,数字を変えて試して下さい。
             '0から使用可

'ご自身の環境に合わせて下さい
            
'使用するCADのexeのフルパス
Private Const CadFullPath = "C:\Program Files\AutoCAD LT 2000i\aclt.exe"
'使用するCADのexeがあるフォルダパス
Private Const CadFolderPath = "C:\Program Files\AutoCAD LT 2000i"


Sub MAKE_DXF()
'////////////////////////////////////////////////////////
'使用条件
  '1本目の直線の始点はX0,Y0
  '2本目の直線は1本目の直線に対して垂直
  '円Cの中心は2本目の直線の終点
  '円Dの中心は1本目の直線の始点
'////////////////////////////////////////////////////////

Dim i As Integer, j As Integer
Dim Ans, ret
Dim strFileName As String
Dim SX(1 To 4) As Double, SY(1 To 4) As Double
Dim EX(1 To 4) As Double, EY(1 To 4) As Double
Dim R(1 To 4) As Double
Dim endX As Double, endY As Double
Dim myTxtFile As String, myDxfFile As String

myTxtFile = ThisWorkbook.Path & "\make_dxf.txt"

'カレントフォルダを使用するCADのexeがあるフォルダに変更
ChDir CadFolderPath

'作成するファイル名入力
myDxfFile = Application.GetSaveAsFilename(InitialFileName:="", _
      FileFilter:="DXFファイル(*.dxf),*.dxf", _
      Title:="作成するDXFファイル名")

If StrConv(myDxfFile, vbUpperCase) = "FALSE" Then Exit Sub
 

'同名ファイルがある場合は上書き確認
If Dir(myDxfFile) <> "" Then
 
  Ans = MsgBox(myDxfFile & "は既に作成されていますが、上書きしますか?", _
     vbExclamation Or vbYesNo, CnsTitle)
 
  If Ans = vbNo Then Exit Sub
 
End If


endX = 0
endY = 0

On Error GoTo err_trap
 
'数値入力
For j = 1 To 4
 
 Select Case j
 
  Case 1, 2
 
   If j = 1 Then
    SX(j) = 0
    SY(j) = 0
   ElseIf j = 2 Then
    SX(j) = EX(j - 1)
    SY(j) = EY(j - 1)
   End If
   
   If j = 1 Then
    EX(j) = CDbl(InputBox(j & "点目 終点X座標は?", CnsTitle, endX))
    EY(j) = 0
   ElseIf j = 2 Then
    EX(j) = EX(1)
    EY(j) = CDbl(InputBox(j & "点目 終点Y座標は?", CnsTitle, endY))
   End If
   
   
    endX = EX(j)
    endY = EY(j)
   
  Case 3
    R(j) = CDbl(InputBox(j & "点目 中心点X" & EX(2) & ",Y" & EY(2) & _
          "の円の半径Rは?", CnsTitle, 0))
    SX(j) = EX(2)
    SY(j) = EY(2)
  Case 4
    R(j) = CDbl(InputBox(j & "点目 中心点X" & SX(1) & ",Y" & SY(1) & _
          "の円の半径Rは?", CnsTitle, 0))
    SX(j) = SX(1)
    SY(j) = SY(1)
 End Select
 
Next
  
On Error GoTo 0

On Error Resume Next
  Kill myTxtFile
  Kill myDxfFile
On Error GoTo 0

i = FreeFile

Open myTxtFile For Output As #i

  'DXFファイル ヘッダー部書き込み(決まり文句)
  
  Print #i, "0"
  Print #i, "SECTION"
  Print #i, "2"
  Print #i, "HEADER"
  
  
  'Print #i, "9"
  'Print #i, "$OSMODE"
  'Print #i, "70"
  'Print #i, "317" '端点1 中点2 中心4 点8、4半円点16 交点32 接線256
  'Print #i, "9"
  'Print #i, "$ORTHOMODE"
  'Print #i, "70"
  'Print #i, "1"
  
  Print #i, "0"
  Print #i, "ENDSEC"
  
  'DXFファイル 線情報書き込み
  Print #i, "0"
  Print #i, "SECTION"
  Print #i, "2"
  Print #i, "ENTITIES"


  For j = 1 To UBound(SX, 1)
   
    Select Case j
   
     '直線
     Case 1, 2
      Print #i, "0"
      Print #i, "LINE" '直線
      Print #i, "8"
      Print #i, "0"  '画層名(LayerName)
      Print #i, "6"
      Print #i, "ByLayer" '線種名(LineTypeName)
      Print #i, "10"
      Print #i, SX(j) '始点X座標
      Print #i, "20"
      Print #i, SY(j) '始点Y座標
      Print #i, "30"
      Print #i, "0" '始点Z座標
      Print #i, "11"
      Print #i, EX(j) '終点X座標
      Print #i, "21"
      Print #i, EY(j) '終点Y座標
      Print #i, "31"
      Print #i, "0" '終点Z座標
      Print #i, "62"
      Print #i, ColorNo '色番号
    
     '円
     Case 3, 4
      Print #i, "0"
      Print #i, "CIRCLE" '円
      Print #i, "8"
      Print #i, "0"
      Print #i, "6"
      Print #i, "ByLayer"
      Print #i, "10"
      Print #i, SX(j) '中心X座標
      Print #i, "20"
      Print #i, SY(j) '中心Y座標
      Print #i, "30"
      Print #i, "0"  '中心Z座標
      Print #i, "40"
      Print #i, R(j)  '半径R
      Print #i, "62"
      Print #i, ColorNo
     End Select
  Next
 
 
  'DXFファイル フッター部(決まり文句)
  Print #i, "0"
  Print #i, "ENDSEC"
  Print #i, "0"
  Print #i, "EOF"

Close #i


'拡張子をtxtからdxfに変更
On Error GoTo err_trap2
Name myTxtFile As myDxfFile
On Error GoTo 0

MsgBox "DXFファイル 作成終了", vbInformation, CnsTitle

'作成したDXFファイルをCADで開く

strFileName = Dir(CadFullPath) & " " & Dir(myDxfFile)
ret = Shell(strFileName, vbNormalFocus)

Exit Sub

err_trap:
  MsgBox "不正な入力がありました。処理を中止します。", vbCritical, CnsTitle
Exit Sub

err_trap2:
  MsgBox "同名のファイルが既に開かれています。", vbCritical, CnsTitle
End Sub

標準モジュールにはここまで

ワークシートにコマンドボタンを一つ配置して、そこに

Private Sub CommandButton1_Click()
 Call MAKE_DXF
End Sub

と書いて終了です。


DXFのファイルフォーマットは2行で一つの意味があります。
詳しくはAutodesk社のDXFリファレンスを参照して下さい。(すべて英語ですが...)
DXFファイルが作成できるようになれば色々できることが増えると思います。

今回は数値の入力部分にインプットボックスを使いましたが、ユーザーフォームを作成
したり、シートから直接値を取り込む方法がなどありますので研究してみて下さい。

【57843】Re:任意の形状を図化するには?
お礼  よう  - 08/9/16(火) 23:34 -

引用なし
パスワード
   みそじのおじさんさん、どうも有難うございます。


実際、数値を与えて見るとCADの中で解決できないものもあったものですから、助かります。

有難うございました!!

4215 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free