AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
[討論]抓取座標合併 Io15011 [討論]抓取座標合併 2020-310 [討論]抓取座標合併 Oiu15010 [討論]抓取座標合併 2020-211 [討論]抓取座標合併 Oo-2-110 [討論]抓取座標合併 BPl3tjj

[討論]抓取座標合併

向下

[討論]抓取座標合併 Empty [討論]抓取座標合併

發表 由 polarwin 2013-12-04, 12:55


大家好
想在一個 長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))
polarwin
polarwin
一般會員
一般會員

文章總數 : 6
年齡 : 40
來自 : 台中
職業 : 製圖
愛好 : 養魚
個性 : 溫和
使用年資 : 5年
使用版本 : 2006
經驗值 : 3047
威望值 : 0
注冊日期 : 2012-12-01
男 天蝎座 猴

回頂端 向下

[討論]抓取座標合併 Empty 畫一個矩形 ( VBA 練習 )

發表 由 shackle_2005 2021-01-11, 14:11

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
shackle_2005
shackle_2005
初級會員
初級會員

文章總數 : 192
年齡 : 49
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 5162
威望值 : 310
注冊日期 : 2010-09-20
男 獅子座 豬

回頂端 向下

[討論]抓取座標合併 Empty 在矩形中間寫出四個座標的數字 ( VBA 練習 )

發表 由 shackle_2005 2021-01-11, 14:24

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
shackle_2005
shackle_2005
初級會員
初級會員

文章總數 : 192
年齡 : 49
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 5162
威望值 : 310
注冊日期 : 2010-09-20
男 獅子座 豬

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[討論]抓取座標合併 Uos15010 [討論]抓取座標合併 BPl3tjj [討論]抓取座標合併 Ziao1510 [討論]抓取座標合併 Oo-2-110 [討論]抓取座標合併 Oooo-110 [討論]抓取座標合併 2020-211