[討論]分享即時顯示聚合線長度LISP-VBA版本
3 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[討論]分享即時顯示聚合線長度LISP-VBA版本
我把線段長度移到中間並隨著聚合線角度旋轉. 參考一下!! 20161214 : 修定, 原來長度再加上整條聚合線的總長. lw_line_length_20161214.dvb. 20161215 修正 : 把長度文字旋轉轉正. pline_length_20161215
- 附件
shackle_2005 在 2016-12-15, 18:14 作了第 3 次修改
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6745
威望值 : 361
注冊日期 : 2010-09-20
學習小孩 likes this post
回復: [討論]分享即時顯示聚合線長度LISP-VBA版本
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Option Explicit
Public Sub lw_line_auto_dim()
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 start_p As Variant
Dim end_p As Variant
Dim lw_line As AcadLWPolyline
Dim plineObj As AcadLWPolyline
Dim points(0 To 3) As Double
Dim text_obj As AcadText
Dim p2 As Variant
Dim p3 As Variant
Dim line_obj As AcadLine
Dim index_pline As Integer
Dim third_p As Variant
start_p = tu.GetPoint(, "輸入聚合線起點....")
If Err Then Exit Sub
end_p = tu.GetPoint(start_p, "輸入點.........")
If Err Then Exit Sub
' Define the 2D polyline points
points(0) = start_p(0): points(1) = start_p(1)
points(2) = end_p(0): points(3) = end_p(1)
' Create a lightweight Polyline object in model space
Set plineObj = tm.AddLightWeightPolyline(points)
line_text_process start_p, end_p
Do While True
index_pline = (UBound(plineObj.Coordinates) + 1) / 2
third_p = tu.GetPoint(end_p, "輸入點.........")
If Err Then Exit Sub
' Define the new vertex
Dim newVertex(0 To 1) As Double
newVertex(0) = third_p(0): newVertex(1) = third_p(1)
' Add the vertex to the polyline
plineObj.AddVertex index_pline, newVertex
plineObj.Update
line_text_process end_p, third_p
end_p = third_p
Loop
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
Private Sub line_text_process(ByVal start_p As Variant, ByVal end_p As Variant)
Dim line_obj As AcadLine
Dim p2 As Variant
Dim p3 As Variant
Dim text_obj As AcadText
Set line_obj = tm.AddLine(start_p, end_p)
p2 = tu.PolarPoint(start_p, line_obj.angle, line_obj.Length / 2)
p3 = tu.PolarPoint(p2, line_obj.angle - 90 / pi, 5)
Set text_obj = tm.AddText(Int(line_obj.Length), p3, line_obj.Length / 10)
text_obj.Rotation = line_obj.angle: text_obj.Update: line_obj.Delete
End Sub
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Option Explicit
Public Sub lw_line_auto_dim()
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 start_p As Variant
Dim end_p As Variant
Dim lw_line As AcadLWPolyline
Dim plineObj As AcadLWPolyline
Dim points(0 To 3) As Double
Dim text_obj As AcadText
Dim p2 As Variant
Dim p3 As Variant
Dim line_obj As AcadLine
Dim index_pline As Integer
Dim third_p As Variant
start_p = tu.GetPoint(, "輸入聚合線起點....")
If Err Then Exit Sub
end_p = tu.GetPoint(start_p, "輸入點.........")
If Err Then Exit Sub
' Define the 2D polyline points
points(0) = start_p(0): points(1) = start_p(1)
points(2) = end_p(0): points(3) = end_p(1)
' Create a lightweight Polyline object in model space
Set plineObj = tm.AddLightWeightPolyline(points)
line_text_process start_p, end_p
Do While True
index_pline = (UBound(plineObj.Coordinates) + 1) / 2
third_p = tu.GetPoint(end_p, "輸入點.........")
If Err Then Exit Sub
' Define the new vertex
Dim newVertex(0 To 1) As Double
newVertex(0) = third_p(0): newVertex(1) = third_p(1)
' Add the vertex to the polyline
plineObj.AddVertex index_pline, newVertex
plineObj.Update
line_text_process end_p, third_p
end_p = third_p
Loop
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
Private Sub line_text_process(ByVal start_p As Variant, ByVal end_p As Variant)
Dim line_obj As AcadLine
Dim p2 As Variant
Dim p3 As Variant
Dim text_obj As AcadText
Set line_obj = tm.AddLine(start_p, end_p)
p2 = tu.PolarPoint(start_p, line_obj.angle, line_obj.Length / 2)
p3 = tu.PolarPoint(p2, line_obj.angle - 90 / pi, 5)
Set text_obj = tm.AddText(Int(line_obj.Length), p3, line_obj.Length / 10)
text_obj.Rotation = line_obj.angle: text_obj.Update: line_obj.Delete
End Sub
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6745
威望值 : 361
注冊日期 : 2010-09-20
回復: [討論]分享即時顯示聚合線長度LISP-VBA版本
這位前輩,
你真的很厲害呢!
你真的很厲害呢!
devinchou- 初級會員
- 文章總數 : 56
年齡 : 47
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 3
經驗值 : 4069
威望值 : 192
注冊日期 : 2015-02-15
回復: [討論]分享即時顯示聚合線長度LISP-VBA版本
devinchou 寫到:這位前輩,
你真的很厲害呢!
不客氣. Lisp, VBA 應該都可以. 但我的經驗 VBA 很方便, 建議大家可以試試.
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6745
威望值 : 361
注冊日期 : 2010-09-20
回復: [討論]分享即時顯示聚合線長度LISP-VBA版本
感謝大大無私地分享......感恩
rickyyang- 專屬會員
- 文章總數 : 196
年齡 : 45
來自 : 台北
職業 : 營建暨室內裝修工程管理
愛好 : 喜愛黃金獵犬、哈士奇
個性 : 誠信、正義、穩健
使用年資 : 17
使用版本 : AutoCAD 2023
經驗值 : 4578
威望值 : 36
注冊日期 : 2014-11-11
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章