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.
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe1-113[討論]分享即時顯示聚合線長度LISP-VBA版本 Ioaoe110[討論]分享即時顯示聚合線長度LISP-VBA版本 2020-310[討論]分享即時顯示聚合線長度LISP-VBA版本 Oiu15010[討論]分享即時顯示聚合線長度LISP-VBA版本 2020-211[討論]分享即時顯示聚合線長度LISP-VBA版本 Ia15010[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao10[討論]分享即時顯示聚合線長度LISP-VBA版本 Uos15010[討論]分享即時顯示聚合線長度LISP-VBA版本 BPl3tjj[討論]分享即時顯示聚合線長度LISP-VBA版本 Ziao1510
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe15010[討論]分享即時顯示聚合線長度LISP-VBA版本 Oo-2-110[討論]分享即時顯示聚合線長度LISP-VBA版本 Zuoiy_10[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao11[討論]分享即時顯示聚合線長度LISP-VBA版本 Iyb_1510[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe1-112[討論]分享即時顯示聚合線長度LISP-VBA版本 Uos15011[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe2da10[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe2da11[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe10

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

3 posters

向下

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

發表 由 shackle_2005 2016-12-14, 16:18

我把線段長度移到中間並隨著聚合線角度旋轉. 參考一下!! 20161214 : 修定, 原來長度再加上整條聚合線的總長. lw_line_length_20161214.dvb. 20161215 修正 : 把長度文字旋轉轉正. pline_length_20161215
附件
[討論]分享即時顯示聚合線長度LISP-VBA版本 Attachment
111.zip 您無權下載這里的附件。(161 Kb) 下載 17 次
[討論]分享即時顯示聚合線長度LISP-VBA版本 Attachment
lw_line_auto_dim_001.zip 您無權下載這里的附件。(22 Kb) 下載 17 次
[討論]分享即時顯示聚合線長度LISP-VBA版本 Attachment
lw_line_length_20161214.zip 您無權下載這里的附件。(11 Kb) 下載 17 次
[討論]分享即時顯示聚合線長度LISP-VBA版本 Attachment
pline_length_20161215.zip 您無權下載這里的附件。(12 Kb) 下載 24 次


shackle_2005 在 2016-12-15, 18:14 作了第 3 次修改

____________________________________________________________________________________
[討論]分享即時顯示聚合線長度LISP-VBA版本 Ioaoe110 [討論]分享即時顯示聚合線長度LISP-VBA版本 Zuoiy_10 [討論]分享即時顯示聚合線長度LISP-VBA版本 2020-211 [討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao11 [討論]分享即時顯示聚合線長度LISP-VBA版本 Iyb_1510
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao10 [討論]分享即時顯示聚合線長度LISP-VBA版本 BPl3tjj.png [討論]分享即時顯示聚合線長度LISP-VBA版本 Ziao1510 [討論]分享即時顯示聚合線長度LISP-VBA版本 Oo-2-110 [討論]分享即時顯示聚合線長度LISP-VBA版本 Oooa_110
shackle_2005
shackle_2005
初級會員
初級會員

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

學習小孩 likes this post

回頂端 向下

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

發表 由 shackle_2005 2016-12-14, 21: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

____________________________________________________________________________________
[討論]分享即時顯示聚合線長度LISP-VBA版本 Ioaoe110 [討論]分享即時顯示聚合線長度LISP-VBA版本 Zuoiy_10 [討論]分享即時顯示聚合線長度LISP-VBA版本 2020-211 [討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao11 [討論]分享即時顯示聚合線長度LISP-VBA版本 Iyb_1510
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao10 [討論]分享即時顯示聚合線長度LISP-VBA版本 BPl3tjj.png [討論]分享即時顯示聚合線長度LISP-VBA版本 Ziao1510 [討論]分享即時顯示聚合線長度LISP-VBA版本 Oo-2-110 [討論]分享即時顯示聚合線長度LISP-VBA版本 Oooa_110
shackle_2005
shackle_2005
初級會員
初級會員

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

回頂端 向下

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

發表 由 devinchou 2016-12-14, 21:51

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

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

回頂端 向下

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

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

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

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

____________________________________________________________________________________
[討論]分享即時顯示聚合線長度LISP-VBA版本 Ioaoe110 [討論]分享即時顯示聚合線長度LISP-VBA版本 Zuoiy_10 [討論]分享即時顯示聚合線長度LISP-VBA版本 2020-211 [討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao11 [討論]分享即時顯示聚合線長度LISP-VBA版本 Iyb_1510
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao10 [討論]分享即時顯示聚合線長度LISP-VBA版本 BPl3tjj.png [討論]分享即時顯示聚合線長度LISP-VBA版本 Ziao1510 [討論]分享即時顯示聚合線長度LISP-VBA版本 Oo-2-110 [討論]分享即時顯示聚合線長度LISP-VBA版本 Oooa_110
shackle_2005
shackle_2005
初級會員
初級會員

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

回頂端 向下

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

發表 由 rickyyang 2022-01-19, 01:01

感謝大大無私地分享......感恩
rickyyang
rickyyang
專屬會員
專屬會員

文章總數 : 196
年齡 : 45
來自 : 台北
職業 : 營建暨室內裝修工程管理
愛好 : 喜愛黃金獵犬、哈士奇
個性 : 誠信、正義、穩健
使用年資 : 17
使用版本 : AutoCAD 2023
經驗值 : 4578
威望值 : 36
注冊日期 : 2014-11-11
[討論]分享即時顯示聚合線長度LISP-VBA版本 Acadad10 男 射手座 馬

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe1-113[討論]分享即時顯示聚合線長度LISP-VBA版本 Ioaoe110[討論]分享即時顯示聚合線長度LISP-VBA版本 2020-310[討論]分享即時顯示聚合線長度LISP-VBA版本 Oiu15010[討論]分享即時顯示聚合線長度LISP-VBA版本 2020-211[討論]分享即時顯示聚合線長度LISP-VBA版本 Ia15010[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao10[討論]分享即時顯示聚合線長度LISP-VBA版本 Uos15010[討論]分享即時顯示聚合線長度LISP-VBA版本 BPl3tjj[討論]分享即時顯示聚合線長度LISP-VBA版本 Ziao1510
[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe15010[討論]分享即時顯示聚合線長度LISP-VBA版本 Oo-2-110[討論]分享即時顯示聚合線長度LISP-VBA版本 Zuoiy_10[討論]分享即時顯示聚合線長度LISP-VBA版本 Aizyao11[討論]分享即時顯示聚合線長度LISP-VBA版本 Iyb_1510[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe1-112[討論]分享即時顯示聚合線長度LISP-VBA版本 Uos15011[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe2da10[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe2da11[討論]分享即時顯示聚合線長度LISP-VBA版本 Aoe10