wzj23020723 发表于 2007-4-12 13:35:00

请问怎么提取CAD图形中所有点的坐标啊

现在我一个CAD图形中，有好多点，我想提取所有点的坐标，保存到EXCEL文件中，用VBA怎么做呢？或者用别的方法

zxj_76 发表于 2007-4-13 16:44:00

点是Point还是Block，可以实现输出的。

翔羽 发表于 2007-4-14 20:11:00

先用getpoint方法获取所需要的点，这样点的坐标就可以赋值输出了！

wenwengg 发表于 2007-5-8 21:52:00

Dim cName As String
Dim nHandle As String
Dim nScale As Double
Dim nRotation As Double
Dim sLayer As String
Dim yline As Integer
Dim ent As Object
Dim obname As String
Dim xy As Variant
Dim varattr As Variant
Dim attrtxt As Variant
    On Error Resume Next

Dim Excel As Excel.Application '定义excle应用程序变量
'Dim ExcelSheet As Object
Dim ExcelWorkbook As Object '定义工作簿变量
Dim ExcelSheet As worksheet '定义工作表变量
Set Excel = CreateObject("excel.application")'激活excel程序
Excel.Workbooks.Open ("属性表.xls") '打开工作薄
Set ExcelSheet = Excel.ActiveWorkbook.Sheets("sheet1") '当前工作表为sheet1

'corow = ExcelSheet.UsedRange.Rows.count '计算工作表的总行数
    '创建Excel应用程序实例
'    Set Excel = GetObject(, "Excel.Application")
    '创建一个新工作簿
'    Set ExcelWorkbook = Excel.Workbooks.Add
    '确保Sheet1工作表为当前工作表
'    Set ExcelSheet = Excel.ActiveSheet
'    Set ExcelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")
    '将新创建的工作簿保存为Excel文件
Excel.Visible = False

yline = 2 '写入行位置
For Each ent In ThisDrawing.ModelSpace '在模型空间里循环
obname = ent.ObjectName '提取对象类型
If obname = "AcDbBlockReference" Then '判断对象是否为块
    cName = ent.Name      '获取块名
    xy = ent.InsertionPoint '获取插入点坐标
    nHandle = ent.handle    '获取块句柄
    nScale = ent.XScaleFactor   '获取比例
    nRotation = ent.Rotation '获取角度
    sLayer = ent.Layer
   
    varattr = ent.GetAttributes ' 将块属性标记和值复制到varattr变量
    attrtxt(0) = varattr(0).TextString '属性值 0
    attrtxt(1) = varattr(1).TextString '属性值 1
    attrtxt(2) = varattr(2).TextString '属性值 2
   
    ExcelSheet.Cells(yline, 1).Value = nHandle
    ExcelSheet.Cells(yline, 2).Value = cName
    ExcelSheet.Cells(yline, 3).Value = xy(0)
    ExcelSheet.Cells(yline, 4).Value = xy(1)
    ExcelSheet.Cells(yline, 5).Value = xy(2)
    ExcelSheet.Cells(yline, 6).Value = obname
    ExcelSheet.Cells(yline, 7).Value = nScale
    ExcelSheet.Cells(yline, 8).Value = nRotation
    ExcelSheet.Cells(yline, 9).Value = sLayer
    ExcelSheet.Cells(yline, 10).Value = attrtxt(0)'属性值 0 写入excle文件
    ExcelSheet.Cells(yline, 11).Value = attrtxt(1)'属性值 1 写入excle文件
    ExcelSheet.Cells(yline, 12).Value = attrtxt(2)'属性值 1 写入excle文件
    yline = yline + 1 '位置加一行
    attrtxt(0) = ""
    attrtxt(1) = ""
    attrtxt(2) = ""

   End If
Next
Excel.Visible = True
Set Excel = Nothing '释放变量
Set ExcelSheet = Nothing

zjh9986 发表于 2007-6-23 11:38:00

<p><strong><font face="Verdana" color="#61b713">请教wenwengg大侠，您给的程序如何使用啊？</font></strong></p><p><strong><font face="Verdana" color="#61b713">我对编程不懂，但我看您写的这个程序是我非常想用的，还望能多多指教！</font></strong></p><p><strong><font face="Verdana" color="#61b713">谢谢！</font></strong></p>
页: [1]
查看完整版本: 请问怎么提取CAD图形中所有点的坐标啊