jsxygshh 发表于 2014-2-8 07:52:25

用数组的形式统计直线长度到EXCEL一个单元格中

请各位帮忙解决，下面的VBA代码如何修改，才可以让选择的直线或多线长度统计到EXCEL的一个单元格内，各长度进行累加，显示长度计算式，先谢谢Public Sub getlength() '统计长度
Set acadApp = GetObject(, "AutoCAD.Application")
Set Xlapp = GetObject(, "Excel.Application")
    Dim entry As AcadEntity, hjx As Variant, FType(0) As Integer, FData(0) As Variant, sjx As AcadSelectionSet, i As Long
    FType(0) = 0
    FData(0) = "Length"
    On Error Resume Next
    ThisDrawing.SelectionSets.Item("sf").Delete
    Set sjx = acadApp.ActiveDocument.SelectionSets.Add("sf")
    sjx.SelectOnScreen
    h = sjx.Count
    sjx.Select acSelectionSetAll, , , FType, FData
    With Xlapp
      k = .ActiveCell.row
      j = .ActiveCell.Column
      For Each entry In sjx
            hjx = entry.Length
            .cells(k, j) = Format(hjx / 1000, "##0.00")
            k = k + 1
            .cells(k, j).Activate
      Next entry
    End With
    sjx.Delete
End Sub

vbcad 发表于 2014-2-8 21:20:34


    With Xlapp
      k = .ActiveCell.row '电子表格中当前单元格的 行号
      j = .ActiveCell.Column'当前单元格的 列号
      For Each entry In sjx
            hjx = entry.Length'获得长度
            .cells(k, j) = Format(hjx / 1000, "##0.00")'在单元格（k行，j列）中写入长度（除以1000），显示两位小数
            k = k + 1'累加行号
            .cells(k, j).Activate'将单元格（k行，j列）置为当前
      Next entry
    End With
从上面可以看出，取得一个图形元素的长度，单元格就会递增（累加）一行。
如果只想写入一个单元格内，则按下面的代码
dim tmpStr as string

    With Xlapp
      k = .ActiveCell.row '电子表格中当前单元格的 行号
      j = .ActiveCell.Column'当前单元格的 列号
      For Each entry In sjx
            hjx = entry.Length'获得长度
hj=hj+hjx'累加线段长度
tmpStr =tmpStr&""& str(hjx )'将长度转换为字符，保存长度

      Next entry
.cells(k, j) =tmpStr '所有线段的长度空格隔开放在一个单元格中
.cells(k+1, j) =hj'在下一行中写入所有线段的长度和
    End With

jsxygshh 发表于 2014-2-10 20:20:51

谢谢vbcad的帮助，调试成功了，十分感谢！

vbcad 发表于 2014-2-11 12:17:22

jsxygshh 发表于 2014-2-10 20:20 static/image/common/back.gif
谢谢vbcad的帮助，调试成功了，十分感谢！

页: [1]
查看完整版本: 用数组的形式统计直线长度到EXCEL一个单元格中