2017-03-07 59 views
0

私は複雑な煙突の3Dモデルを持っています。これは本質的に装飾的な特徴を持つ円筒形のチューブです。私はその長さに沿っていくつかのポイントでセクションのプロパティを見つけるVBAスクリプトを書いてみたいですが、私はそれをやる方法が本当にわかりません。オンライン検索からAutoCAD VBA:オブジェクトの選択

、私はその後、上MASSPROPを実行することができますが、私はそれを終えることがどのように非常にわからない時点でセクションに置くコードを書くことができた...私は」だと思いますたった1行分のコードです。私はちょうど私が作成したセクションを選択する必要があります。

私の助けが必要なコードは、私のほぼ完全なコードです。

Public Sub Section() 
Dim SolidObject As Acad3DSolid 
Dim NewRegionObject As AcadRegion 
Dim PlaneOrigin As Variant 
Dim PlaneXaxisPoint As Variant 
Dim PlaneYaxisPoint As Variant 
Dim PickedPoint As Variant 
On Error Resume Next 
With ThisDrawing.Utility 
.GetEntity SolidObject, PickedPoint, vbCr & "Select solid to cut." 
If Err Then 
    MsgBox "Selected solid must be a 3DSolid" 
    Exit Sub 
End If 
PlaneOrigin = .GetPoint(PickedPoint, vbCr & "Select point to define origin.") 
PlaneXaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define x-axis.") 
PlaneYaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define y-axis.") 
Set NewRegionObject = SolidObject.SectionSolid(PlaneOrigin, PlaneXaxisPoint, PlaneYaxisPoint) 
End With 
ThisDrawing.SendCommand ("qaflags" & vbCr & "2" & vbCr) 'This is needed for the operation 
ThisDrawing.SendCommand ("massprop" & vbCr) 
'How do I select my NewRegionObject??? 
ThisDrawing.SendCommand (vbCr & vbCr & "y" & vbCr & vbCr & "y" & vbCr) 
End Sub 

私は、新しく作成されたセクションでMASSPROPを実行するには、このコードを取得できた場合は罰金、私は煙突に沿ったいくつかの点でプロセスを自動的に行うには、それを適応させることができるはずですので、私は1行だけだと思いますコードオフ。あなたの助けのための

おかげで、 トム

+0

あなたが本当にあなたのコードをインデントする必要があります。 'Sub ... End Sub'はブロックです。 「With ... End With」だけではなく、「With With ... With With」は別のものです! –

+0

[API](http://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-DFE47717-F7AF-443B-AD78-4E0BB60121C7)が役に立ちますが、 .sendCommandから返されたオブジェクトは、あなたが持っている何らかの手段でregionオブジェクトを実行するか、または 'find'する関数を使って書き直してください。 –

答えて

0

あなたがより良いAutoCADのオブジェクトモデルを活用したい:

Dim minPoint As Variant, maxPoint As Variant 
Set NewRegionObject = SolidObject.SectionSolid(PlaneOrigin, PlaneXaxisPoint, PlaneYaxisPoint) 
With NewRegionObject 
    MsgBox "Area: " & .Area 
    MsgBox "Perimeter: " & .Perimeter 

    .GetBoundingBox minPoint, maxPoint 
    MsgBox "Min Point coordinates: (" & minPoint(0) & "," & minPoint(1) & "," & minPoint(2) & ")" 
    MsgBox "Max Point coordinates: (" & maxPoint(0) & "," & maxPoint(1) & "," & maxPoint(2) & ")" 
    MsgBox "Centroid coordinates: (" & .Centroid(0) & "," & .Centroid(1) & ")" 
    MsgBox "Moments of Inertia: (" & .MomentOfInertia(0) & "," & .MomentOfInertia(1) & "," & .MomentOfInertia(2) & ")" 
    '.. and so on 
End With 
+0

こんにちは、ありがとうございます。 コードはうまくいきましたが、私はExcel VBAで動作するようにそれを適応させるのに苦労しています。私は 'ThisDrawing'を 'ACAD.ActiveDocument'に置き換えようとしましたが、動作していないようです。元の投稿を編集して新しいコードを表示しました。 –

+0

ようこそ。解決策を受け取った後に質問を変更すると、ここで許可されていない「シャンレオン」の質問につながることにご注意ください。だから、あなたの質問を再開_original_バージョンと私の答えが解決した場合はそれを受け入れたとしてマークしてください。あなたはあなたの新しい問題のために新しい投稿をしたいかもしれませんが。ありがとう、 – user3598756

+0

申し訳ありません、私はこれに新しいです、それは今うまくいくはずです –

関連する問題