[分享]文字外框圓角(VBA)
2 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[分享]文字外框圓角(VBA)
文字加外框透過Acadpolyline.setBulge 方法去執行
如果不想要方方正正的外框的話可以嘗試用這個code去擬合
就會得到滿好看的圓角說明外框囉~
使用時需要先用thisdrawing.modelspace.addtext創ㄧ個textobj然後呼叫AddTextbox(textobj)
如果不想要方方正正的外框的話可以嘗試用這個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
經驗值 : 2625
威望值 : 34
注冊日期 : 2018-03-15
回復: [分享]文字外框圓角(VBA)
只看函數,沒看到測試程序,我就自己寫一個簡易的測試程式
不過我測試一下
文字大小太大太小會出現問題
文字大小0.25,會像用倒角
文字大小2.5,沒問題
圖的右邊是文字大小25,沒問題
圖的左邊是文字大小250
文字大小2500會出現極大物件
應該是凸出度計算出錯了
- 代碼:
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會出現極大物件
應該是凸出度計算出錯了
naruto018- 中級會員
- 文章總數 : 226
年齡 : 32
來自 : 高雄
職業 : 學習中(CAD,Revit,Excel VBA)
愛好 : 當個懶熊
個性 : 內向
使用年資 : 新手
使用版本 : 2015
AutoCAD基礎篇等級 : 10星級
積分 : 5
經驗值 : 4558
威望值 : 564
注冊日期 : 2016-11-29
回復: [分享]文字外框圓角(VBA)
非常感謝您的測試
凸出度的確是我一開始所遇到的問題
其實Setbulge把它的凸出度改為0.4就可以了
我想太多XDD
已修正程式碼!
凸出度的確是我一開始所遇到的問題
其實Setbulge把它的凸出度改為0.4就可以了
我想太多XDD
已修正程式碼!
林宗漢- 一般會員
- 文章總數 : 24
年齡 : 29
來自 : 雲林
職業 : 水利工程技師
愛好 : AutoCADVBA/ExcelVBA
個性 : 樂於分享
使用年資 : 2年
使用版本 : AutoCAD2016
經驗值 : 2625
威望值 : 34
注冊日期 : 2018-03-15
回復: [分享]文字外框圓角(VBA)
林宗漢 寫到:非常感謝您的測試
凸出度的確是我一開始所遇到的問題
其實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- 中級會員
- 文章總數 : 226
年齡 : 32
來自 : 高雄
職業 : 學習中(CAD,Revit,Excel VBA)
愛好 : 當個懶熊
個性 : 內向
使用年資 : 新手
使用版本 : 2015
AutoCAD基礎篇等級 : 10星級
積分 : 5
經驗值 : 4558
威望值 : 564
注冊日期 : 2016-11-29
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章