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

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



如果不想要方方正正的外框的話可以嘗試用這個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


只看函數，沒看到測試程序，我就自己寫一個簡易的測試程式

代碼:

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會出現極大物件
應該是凸出度計算出錯了

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

林宗漢 寫到:非常感謝您的測試
凸出度的確是我一開始所遇到的問題
其實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