[討論]抓取座標合併

大家好
想在一個 長400寬300的矩形,抓取第一點座標x,y (若第一點為 23591.000,42878.000)
將座標合併為23592878文字,然後顯示在矩形中間
以下是我目前寫的,再來就不會了
請大家建議一下
謝謝
(defun c:55()
(setq y (entsel))
(setq cen (entget (car y)))
(setq p1 (cdr (assoc 10 cen)))
(setq pt1 (cdr p1))
(setq px (car pt1))
(setq py (cadr pt1))

Option Explicit

Public tm As AcadModelSpace ' 設 tm 簡化名稱圖紙空間
Public tu As AcadUtility
Public pi As Double

Public Sub rect_drawing() ' 畫一個矩形

On Error Resume Next

ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
pi = 3.141592 / 180

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Dim p1(0 To 2) As Double ' 矩形左下角點座標
Dim p2(0 To 2) As Double ' 矩形右上角點座標
Dim p1_str As String
Dim p2_str As String

p1(0) = 23591: p1(1) = 42878
p2(0) = p1(0) + 300: p2(1) = p1(1) + 400

p1_str = Trim(Str(p1(0))) & "," & Trim(Str(p1(1))) ' 把 X 座標 + "," + Y 座標, 結合給 sendcommand 使用
p2_str = Trim(Str(p2(0))) & "," & Trim(Str(p2(1)))

ThisDrawing.SendCommand "rectangle" & vbCr & p1_str & vbCr & p2_str & vbCr

ZoomCenter p1, 10 ^ 3

ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr

End Sub

Option Explicit

Public tm As AcadModelSpace ' 設 tm 簡化名稱圖紙空間
Public tu As AcadUtility
Public pi As Double

Public Sub test()

On Error Resume Next

ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
pi = 3.141592 / 180

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Dim rect As AcadLWPolyline
Dim coor As Variant
Dim p1 As Variant
Dim p2 As Variant
Dim center_p(0 To 2) As Double
Dim text_obj As AcadText
Dim i_count As Integer
Dim coor_str As String
Dim p3 As Variant
Dim pick_p As Variant

tu.GetEntity rect, pick_p, "請選取矩形 : "

If Err Then Exit Sub

coor = rect.Coordinates ' 取得矩形的點座標

rect.GetBoundingBox p1, p2 ' 取得矩形的左下角及右下角座標

center_p(0) = (p1(0) + p2(0)) / 2: center_p(1) = (p1(1) + p2(1)) / 2 ' 計算得到矩行的中心點

For i_count = 0 To (UBound(coor) - 1) / 2 ' 一一叫出四個座標

   p3 = tu.PolarPoint(center_p, 270 * pi, i_count * 20)

   coor_str = Trim(Str(Int(coor(i_count * 2)))) & Trim(Str(Int(coor(i_count * 2 + 1)))) ' XY座標結合成字串

   Set text_obj = tm.AddText(coor_str, p3, 10): text_obj.Update

Next i_count

ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr

End Sub