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

[討論]分享即時顯示聚合線長度LISP-VBA版本

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

[討論]分享即時顯示聚合線長度LISP-VBA版本

發表 由 shackle_2005 于 2016-12-14, 08:18

我把線段長度移到中間並隨著聚合線角度旋轉. 參考一下!! 20161214 : 修定, 原來長度再加上整條聚合線的總長. lw_line_length_20161214.dvb. 20161215 修正 : 把長度文字旋轉轉正. pline_length_20161215
附件
111.zip 您無權下載這里的附件。(161 Kb) 下載 1 次
lw_line_auto_dim_001.zip 您無權下載這里的附件。(22 Kb) 下載 1 次
lw_line_length_20161214.zip 您無權下載這里的附件。(11 Kb) 下載 0 次
pline_length_20161215.zip 您無權下載這里的附件。(12 Kb) 下載 1 次


shackle_2005 在 2016-12-15, 10:14 作了第 3 次修改
avatar
shackle_2005
初級會員
初級會員

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

回頂端 向下

回復: [討論]分享即時顯示聚合線長度LISP-VBA版本

發表 由 shackle_2005 于 2016-12-14, 13:49

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

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

回頂端 向下

回復: [討論]分享即時顯示聚合線長度LISP-VBA版本

發表 由 devinchou 于 2016-12-14, 13:51

這位前輩,
你真的很厲害呢!
avatar
devinchou
初級會員
初級會員

文章總數 : 49
年齡 : 39
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 2
經驗值 : 1396
威望值 : 150
注冊日期 : 2015-02-15
男 天蝎座 蛇

回頂端 向下

回復: [討論]分享即時顯示聚合線長度LISP-VBA版本

發表 由 shackle_2005 于 2016-12-14, 14:07

devinchou 寫到:這位前輩,
你真的很厲害呢!

不客氣. Lisp, VBA 應該都可以. 但我的經驗 VBA 很方便, 建議大家可以試試.
avatar
shackle_2005
初級會員
初級會員

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

回頂端 向下

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


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