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.
[分享]文字外框圓角(VBA) Ioaoe110[分享]文字外框圓角(VBA) 2020-310[分享]文字外框圓角(VBA) Oiu15010[分享]文字外框圓角(VBA) 2020-211[分享]文字外框圓角(VBA) Ia15010[分享]文字外框圓角(VBA) Aizyao10[分享]文字外框圓角(VBA) Uos15010[分享]文字外框圓角(VBA) BPl3tjj[分享]文字外框圓角(VBA) Ziao1510
[分享]文字外框圓角(VBA) Oo-2-110[分享]文字外框圓角(VBA) Zuoiy_10[分享]文字外框圓角(VBA) Aizyao11[分享]文字外框圓角(VBA) Iyb_1510[分享]文字外框圓角(VBA) Aoe1-111[分享]文字外框圓角(VBA) Uos15011[分享]文字外框圓角(VBA) Aoe2da10[分享]文字外框圓角(VBA) Aoe2da11[分享]文字外框圓角(VBA) Aoe10

[分享]文字外框圓角(VBA)

2 posters

向下

[分享]文字外框圓角(VBA) Empty [分享]文字外框圓角(VBA)

發表 由 林宗漢 2019-01-17, 16:40

文字加外框透過Acadpolyline.setBulge 方法去執行

[分享]文字外框圓角(VBA) Su12

如果不想要方方正正的外框的話可以嘗試用這個code去擬合
就會得到滿好看的圓角說明外框囉~

使用時需要先用thisdrawing.modelspace.addtext創ㄧ個textobj然後呼叫AddTextbox(textobj)

代碼:


Function AddTextBox(ByVal txtobj As Object)

Dim ldpt(2) As Double
Dim rupt(2) As Double

Set entobj = txtobj

Call entobj.GetBoundingBox(Min, Max)

r = Sqr((Max(0) - Max(0)) ^ 2 + (Max(1) - Min(1)) ^ 2)

ldpt(0) = Min(0) - 0.2 * r: ldpt(1) = Min(1) - 0.2 * r
rupt(0) = Max(0) + 0.2 * r: rupt(1) = Max(1) + 0.2 * r
 
Set AddTextBox = PlotRecFillet(ldpt, rupt, 0.4 * r)

End Function

Function PlotRecFillet(ByRef LeftLowerPoint() As Double, ByRef RightUpperPoint() As Double, ByVal r As Double)

Dim vertices(9 * 3 - 1) As Double
Dim Rec As Object

X1 = LeftLowerPoint(0): Y1 = LeftLowerPoint(1)
X2 = RightUpperPoint(0): Y2 = RightUpperPoint(1)

vertices(0) = X1: vertices(1) = Y1 + r
vertices(3) = X1 + r: vertices(4) = Y1
vertices(6) = X2 - r: vertices(7) = Y1
vertices(9) = X2: vertices(10) = Y1 + r
vertices(12) = X2: vertices(13) = Y2 - r
vertices(15) = X2 - r: vertices(16) = Y2
vertices(18) = X1 + r: vertices(19) = Y2
vertices(21) = X1: vertices(22) = Y2 - r
vertices(24) = X1: vertices(25) = Y1 + r

Set tmp = thisdrawing.modelspace.AddPolyLine(vertices)

tmp.SetBulge 0, 0.4
tmp.SetBulge 2, 0.4
tmp.SetBulge 4, 0.4
tmp.SetBulge 6, 0.4

Set PlotRecFillet = tmp

End Function


林宗漢 在 2019-01-17, 23:04 作了第 1 次修改
林宗漢
林宗漢
一般會員
一般會員

文章總數 : 24
年齡 : 29
來自 : 雲林
職業 : 水利工程技師
愛好 : AutoCADVBA/ExcelVBA
個性 : 樂於分享
使用年資 : 2年
使用版本 : AutoCAD2016
經驗值 : 2371
威望值 : 34
注冊日期 : 2018-03-15
男 雙魚座 豬

回頂端 向下

[分享]文字外框圓角(VBA) Empty 回復: [分享]文字外框圓角(VBA)

發表 由 naruto018 2019-01-17, 18:40

只看函數,沒看到測試程序,我就自己寫一個簡易的測試程式
代碼:
Sub Example_AddTextBox()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    gpCode(0) = 0
    dataValue(0) = "TEXT"
    
    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue

    ssetObj.SelectOnScreen groupCode, dataCode
    For Each i In ssetObj
        AddTextBox (i)
    Next
    ssetObj.Delete
End Sub

不過我測試一下
文字大小太大太小會出現問題
文字大小0.25,會像用倒角
文字大小2.5,沒問題
圖的右邊是文字大小25,沒問題
圖的左邊是文字大小250
文字大小2500會出現極大物件
應該是凸出度計算出錯了
[分享]文字外框圓角(VBA) O-201914
naruto018
naruto018
中級會員
中級會員

文章總數 : 205
年齡 : 32
來自 : 高雄
職業 : 學習中(CAD,Revit,Excel VBA)
愛好 : 當個懶熊
個性 : 內向
使用年資 : 新手
使用版本 : 2015
AutoCAD基礎篇等級 : 10星級
積分 : 5
經驗值 : 4195
威望值 : 558
注冊日期 : 2016-11-29
藍鵲726號
男 摩羯座 羊

回頂端 向下

[分享]文字外框圓角(VBA) Empty 回復: [分享]文字外框圓角(VBA)

發表 由 林宗漢 2019-01-17, 19:30

非常感謝您的測試
凸出度的確是我一開始所遇到的問題
其實Setbulge把它的凸出度改為0.4就可以了
我想太多XDD
已修正程式碼!
林宗漢
林宗漢
一般會員
一般會員

文章總數 : 24
年齡 : 29
來自 : 雲林
職業 : 水利工程技師
愛好 : AutoCADVBA/ExcelVBA
個性 : 樂於分享
使用年資 : 2年
使用版本 : AutoCAD2016
經驗值 : 2371
威望值 : 34
注冊日期 : 2018-03-15
男 雙魚座 豬

回頂端 向下

[分享]文字外框圓角(VBA) Empty 回復: [分享]文字外框圓角(VBA)

發表 由 naruto018 2019-01-18, 09:51

林宗漢 寫到:非常感謝您的測試
凸出度的確是我一開始所遇到的問題
其實Setbulge把它的凸出度改為0.4就可以了
我想太多XDD
已修正程式碼!

凸出度
建議改0.414214
會趨近於90度的弧的凸出度

LISP的凸出度函數
代碼:
;;;(Angle->Bulge 起始角度 終止角度)
;;;回傳:凸度
(defun Angle->Bulge ( a1 a2 / bk )
    ((lambda (a) (/ (sin a) (cos a)))
          (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
        )
    );_結束

_$ (Angle->Bulge (* PI 1.0) (* PI 1.5))
0.414214
naruto018
naruto018
中級會員
中級會員

文章總數 : 205
年齡 : 32
來自 : 高雄
職業 : 學習中(CAD,Revit,Excel VBA)
愛好 : 當個懶熊
個性 : 內向
使用年資 : 新手
使用版本 : 2015
AutoCAD基礎篇等級 : 10星級
積分 : 5
經驗值 : 4195
威望值 : 558
注冊日期 : 2016-11-29
藍鵲726號
男 摩羯座 羊

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[分享]文字外框圓角(VBA) Ioaoe110[分享]文字外框圓角(VBA) 2020-310[分享]文字外框圓角(VBA) Oiu15010[分享]文字外框圓角(VBA) 2020-211[分享]文字外框圓角(VBA) Ia15010[分享]文字外框圓角(VBA) Aizyao10[分享]文字外框圓角(VBA) Uos15010[分享]文字外框圓角(VBA) BPl3tjj[分享]文字外框圓角(VBA) Ziao1510
[分享]文字外框圓角(VBA) Oo-2-110[分享]文字外框圓角(VBA) Zuoiy_10[分享]文字外框圓角(VBA) Aizyao11[分享]文字外框圓角(VBA) Iyb_1510[分享]文字外框圓角(VBA) Aoe1-111[分享]文字外框圓角(VBA) Uos15011[分享]文字外框圓角(VBA) Aoe2da10[分享]文字外框圓角(VBA) Aoe2da11[分享]文字外框圓角(VBA) Aoe10