lxy513 发表于 2009-2-12 18:12:00

CAD 与VB 数据的结合，高手进！

请教大侠，我想利用VB程序提取CAD图形（简单图形）的各顶点的坐标，苦于知识浅薄，请不吝赐教。谢谢。

pmq 发表于 2009-2-12 20:26:00

Sub Start()<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim Sel As AcadSelectionSet&nbsp;&nbsp;&nbsp; '选择集<br/>&nbsp;&nbsp;&nbsp; Dim Obj As AcadObject&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '<br/>&nbsp;&nbsp;&nbsp; Dim Sxyh As Variant<br/>&nbsp;&nbsp;&nbsp; Dim Exyh As Variant<br/>&nbsp;&nbsp;&nbsp; Dim Coord As Variant<br/>&nbsp;&nbsp;&nbsp; Dim XYZ(2) As Double<br/>&nbsp;&nbsp;&nbsp; Dim Js As Long<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Open "C:\XYH.dat" For Output As #1<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '错误处理<br/>&nbsp;&nbsp;&nbsp; Set Sel = ThisDrawing.SelectionSets("ss")<br/>&nbsp;&nbsp;&nbsp; If Err Then Set Sel = ThisDrawing.SelectionSets.Add("ss")<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '初始状态下清空选择集<br/>&nbsp;&nbsp;&nbsp; Sel.Clear<br/>&nbsp;&nbsp;&nbsp; Sel.SelectOnScreen<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; For Each Obj In Sel<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Obj.ObjectName = "AcDbLine" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Js = Js + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sxyh = Obj.StartPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exyh = Obj.EndPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'XYZ_P_C Sxyh&nbsp;&nbsp; '屏幕坐标转测量坐标<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Print #1, Str(Js); " , "; Str(Js); " , "; Sxyh(1); " , "; Sxyh(0); " , "; Sxyh(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Js = Js + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'XYZ_P_C Exyh<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Print #1, Str(Js); " , "; Str(Js); " , "; Exyh(1); " , "; Exyh(0); " , "; Exyh(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf Obj.ObjectName = "AcDbPolyline" Or Obj.ObjectName = "AcDb2dPolyline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Coord = Obj.Coordinates<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; XYZ(2) = Obj.Elevation<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(Coord) Step 3<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Js = Js + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; XYZ(1) = Coord(i + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; XYZ(0) = Coord(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'XYZ_P_C XYZ<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Print #1, Str(Js); " , "; Str(Js); " , "; XYZ(1); " , "; XYZ(0); " , "; XYZ(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf Obj.ObjectName = "AcDb3dPolyline" Or Obj.ObjectName = "AcDbSpline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Coord = Obj.Coordinates<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(Coord) Step 3<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Js = Js + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; XYZ(1) = Coord(i + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; XYZ(0) = Coord(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; XYZ(2) = Coord(i + 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'XYZ_P_C XYZ<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Print #1, Str(Js); " , "; Str(Js); " , "; XYZ(1); " , "; XYZ(0); " , "; XYZ(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Js = 0<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; Close<br/>End Sub<br/>

caiqs 发表于 2009-2-13 07:56:00

<p>楼上理解错误,他说的是VB程序打开cad,而非vba</p><p>打开VB，添加一个窗体，加上如下代码，然后运行，也可以编译成exe再运行</p><p>这段代码的作用是用VB程序打开dwg文件并写一行文字到模型空间，然后保存</p><p>Private Sub Form_Load()</p><p>On Error Resume Next<br/>Dim acadapp As object<br/>Set acadapp = CreateObject("AutoCAD.application")<br/>acadapp.Visible = False '是否显示<br/>Dim doc As object<br/>Set doc = acadapp.Documents.Open("c:/test.dwg") '打开文档<br/>doc.Activate<br/>Dim insertpt(2) As Double<br/>insertpt(0) = 0: insertpt(1) = 0: insertpt(2) = 0<br/>doc.ModelSpace.AddText "用VB打开AutoCAD例子程序", insertpt, 5<br/>acadapp.ZoomAll<br/>doc.Close True '并闭并保存<br/>acadapp.Quit '退出cad<br/>End Sub</p><p></p><p></p><p></p><p></p>
页: [1]
查看完整版本: CAD 与VB 数据的结合，高手进！