[討論]抓取座標合併
2 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[討論]抓取座標合併
大家好
想在一個 長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- 一般會員
- 文章總數 : 6
年齡 : 43
來自 : 台中
職業 : 製圖
愛好 : 養魚
個性 : 溫和
使用年資 : 5年
使用版本 : 2006
經驗值 : 4353
威望值 : 0
注冊日期 : 2012-12-01
畫一個矩形 ( VBA 練習 )
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
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- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6710
威望值 : 361
注冊日期 : 2010-09-20
在矩形中間寫出四個座標的數字 ( VBA 練習 )
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
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- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6710
威望值 : 361
注冊日期 : 2010-09-20
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章