【問題】如何匯出矩形或多邊形端點座標

由 **Elly** 周四 18 1月 2018 - 10:36

我想匯出矩形或多邊形端點座標(比如有5-10個分別在不同座標)
已有使用「資料萃取」精靈 dataextraction指令試過
但裡面只有可選原點的XY座標，以下是我想知道的資訊，謝謝
1.要如何知道各點資訊並匯出(.xls)呢?
2.另外還可顯示每個物件的角度嗎?(匯出.xls)
3.匯出資料顯示每個物件的名稱A.B.C(圖面不是圖塊，文字和polyline是分開的)
【問題】如何匯出矩形或多邊形端點座標 Y10

由 **Tiger&蘋果爸** 周四 18 1月 2018 - 11:37

Elly 寫到:我想匯出矩形或多邊形端點座標(比如有5-10個分別在不同座標)
已有使用「資料萃取」精靈 dataextraction指令試過
但裡面只有可選原點的XY座標，以下是我想知道的資訊，謝謝
1.要如何知道各點資訊並匯出(.xls)呢?
2.另外還可顯示每個物件的角度嗎?(匯出.xls)
3.匯出資料顯示每個物件的名稱A.B.C(圖面不是圖塊，文字和polyline是分開的)

資料萃取沒有這麼多的功能！
你的客製化需求只能靠程式達成！

由 **Elly** 周四 18 1月 2018 - 13:10

這可難倒我了，我不會寫程式阿!哭哭!!
那有差不多的程式可用嗎?
但我用List查詢是可以看到一個物件每個點的XY座標
只不過如果查詢幾個是可以，如果有上千個要查不就昏倒

由 **shackle_2005** 周六 20 1月 2018 - 15:54

Dim obj As AcadObject
Dim lw_line As AcadLWPolyline
Dim coor As Variant
Dim start_p(0 To 2) As Double
Dim i_count As Integer
Dim coor_str As String
Dim text_obj As AcadText
Dim p2 As Variant

coor_str = ""

For Each obj In tm
If TypeOf obj Is AcadLWPolyline Then ' 檢查物件是不是 2D 聚合線

Set lw_line = obj: lw_line.Color = 1: lw_line.Update ' 如果是聚合線就改為紅線

coor = lw_line.Coordinates ' 抽出線的 2D 座標

start_p(0) = coor(0): start_p(1) = coor(1) ' 這是第一個點

For i_count = 0 To (UBound(coor) - 1) / 2 ' 抽出每一個點的 X, Y 座標寫在圖面上
coor_str = Int(coor(i_count * 2)) & "," & Int(coor(i_count * 2 + 1))

p2 = tu.PolarPoint(start_p, 270 * pi, i_count * 7)

Set text_obj = tm.AddText(coor_str, p2, 5): text_obj.Update
Next i_count
End If
Next obj

附件