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

[討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

上一篇主題 下一篇主題 向下

[討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 kid530 于 2017-04-13, 06:39

最近工作的關係~~~需要算大量的數量
遇到不少多邊形跟不規則的矩形.....在標註上出現了不少問題
怎像才能夠像圖片這樣標註
把不規則矩形跟多邊形的邊長都標註出來...
希望各位大大幫幫忙

很想學VBA自己作方便的小程式
無奈不是學程式設計的~~~VBA的書也買了好幾本~~真的是有看沒有懂





附件
530T.zip 附件:您無權下載這里的附件。(38 Kb) 下載 7 次
avatar
kid530
一般會員
一般會員

文章總數 : 9
年齡 : 36
來自 : 新北市中和區
職業 : 工地主任
愛好 : 睡覺
個性 : 文靜
使用年資 : 10
使用版本 : 2015
經驗值 : 785
威望值 : 6
注冊日期 : 2015-08-21
男 處女座 猴

回頂端 向下

回復: [討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 Atsai 于 2017-04-13, 09:12

kid530 寫到:


隱藏的代碼是明經通道Gu_xl寫的Lisp,如果標示的方向內外相反的話,是因為Pline的順、逆時針方向的緣故,轉個向就好了!
指令:tt
可一次選多條Pline


Atsai 在 2017-04-13, 09:42 作了第 1 次修改
avatar
Atsai
中級會員
中級會員

文章總數 : 115
年齡 : 42
來自 : 台中
職業 : 工程
愛好 : 看漫畫
個性 : 樂天
使用年資 : 10
使用版本 : 2010
AutoCAD基礎篇等級 : 10星級
積分 : 7
經驗值 : 2838
威望值 : 337
注冊日期 : 2012-04-06
男 金牛座 兔

回頂端 向下

回復: [討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 kid530 于 2017-04-13, 09:23

發生錯誤了~~~

指令: TT
字高<10.0>20
選取物件: 找到 1 個
選取物件:
; 錯誤: no function definition: VLAX-CURVE-GETENDPARAM


指令: TT
字高<10.0>20
選取物件: 找到 1 個
選取物件: 找到 1 個,共 2
選取物件: ; 錯誤: no function definition: VLAX-CURVE-GETENDPARAM


avatar
kid530
一般會員
一般會員

文章總數 : 9
年齡 : 36
來自 : 新北市中和區
職業 : 工地主任
愛好 : 睡覺
個性 : 文靜
使用年資 : 10
使用版本 : 2015
經驗值 : 785
威望值 : 6
注冊日期 : 2015-08-21
男 處女座 猴

回頂端 向下

回復: [討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 Atsai 于 2017-04-13, 09:43

少了一句
(vl-load-com)

重新再抓一次,我重新加進去了!
avatar
Atsai
中級會員
中級會員

文章總數 : 115
年齡 : 42
來自 : 台中
職業 : 工程
愛好 : 看漫畫
個性 : 樂天
使用年資 : 10
使用版本 : 2010
AutoCAD基礎篇等級 : 10星級
積分 : 7
經驗值 : 2838
威望值 : 337
注冊日期 : 2012-04-06
男 金牛座 兔

回頂端 向下

VBA 教學時間, 長度文字旋轉角度給的 sample 有點亂, 所以點到為止. 請多指教, 3Q !!

發表 由 shackle_2005 于 2017-04-13, 11:14

Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
 
Option Explicit

Public Sub dim_pline()

ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr

On Error Resume Next

' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Dim lw_line As AcadLWPolyline
Dim coord As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim line_angle As Double
Dim temp_line As AcadLine
Dim line_length As Double
Dim mid_p As Variant
Dim text_obj As AcadText
Dim i_count As Integer

Do While True

tu.GetEntity lw_line, "請選擇 2D 聚合線 !! 按 Esc 鍵離開........."

If Err Then Exit Do

coord = lw_line.Coordinates ' 取得 2D 聚合線的 X, Y 座標

' 從聚合線的第一段開始標長度, 到最後一段.
For i_count = 0 To (UBound(coord) + 1) / 2 - 1 ' (Ubound(coord) + 1) / 2 -1 是在算聚合線有幾個端點
     
   p1(0) = coord(i_count * 2): p1(1) = coord(i_count * 2 + 1) ' 取得第一個點
   
   ' 取得第二個點, 假如第一個點是聚合線的尾端, 那第二點就是聚合線的首端.
   If i_count = (UBound(coord) + 1) / 2 - 1 Then
      p2(0) = coord(0): p2(1) = coord(1)
   Else
      p2(0) = coord((i_count + 1) * 2): p2(1) = coord((i_count + 1) * 2 + 1)
   End If
   
   Set temp_line = tm.AddLine(p1, p2) ' 畫一條假功能的直線取得線長及角度
   
   line_angle = temp_line.angle: line_length = Int(temp_line.Length * 10) / 10
   
   mid_p = tu.PolarPoint(p1, line_angle, line_length / 2) ' 取得線段的中點
   
   Set text_obj = tm.AddText(line_length, mid_p, 10): text_obj.Update ' 標上長度

   temp_line.Delete
Next i_count

Loop

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

End Sub
附件
dim_pline.zip 您無權下載這里的附件。(21 Kb) 下載 5 次
avatar
shackle_2005
初級會員
初級會員

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

回頂端 向下

回復: [討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 kid530 于 2017-04-20, 04:05

感謝Atsai熱心分享~~~減少我很多工作的時間
測試完成~~~結果相當方便
也感謝這個論壇讓我在有問題的時候能得到解決
也感謝shackle_2005的補充教學
雖然我還是看不懂
但是對於懂的人應該有很大的幫助
感謝再感謝~~~~

avatar
kid530
一般會員
一般會員

文章總數 : 9
年齡 : 36
來自 : 新北市中和區
職業 : 工地主任
愛好 : 睡覺
個性 : 文靜
使用年資 : 10
使用版本 : 2015
經驗值 : 785
威望值 : 6
注冊日期 : 2015-08-21
男 處女座 猴

回頂端 向下

回復: [討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 im2016 于 2017-04-30, 02:38

謝謝shackle_2005熱心分享VBA程式~感恩
avatar
im2016
一般會員
一般會員

文章總數 : 2
年齡 : 37
來自 : 台北
職業 : 待業
愛好 : 運動
個性 : 溫和
使用年資 : 新手初學
使用版本 : 新手初學
經驗值 : 571
威望值 : 0
注冊日期 : 2016-02-02
男 雙子座 猴

回頂端 向下

回復: [討論]矩形,多邊形,不規則多邊形--邊長標註尺寸

發表 由 shackle_2005 于 2017-05-05, 09:59

謝謝 kid530, im2016. 任何有關 VBA 的問題, 歡迎提出來大家一起討論. 3Q
avatar
shackle_2005
初級會員
初級會員

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

回頂端 向下

上一篇主題 下一篇主題 回頂端


 
這個論壇的權限:
無法 在這個版面回復文章