[討論]請問倒圓角時,要如何連續倒不同r的圓角

各位大大:

請問 一下在倒圓角時,能否簡單快速的倒不同R的圓角.就是不用再輸入 R  再給R值,

而是直接輸入R值就能連續倒不同R的圓角,試了好久 找了好多資料都無法解決.

底下圖 是一個簡單的矩形導4個不同R 的圓角

給個 sample 吧!! 因為我只會寫程式不會畫圖!! thanks

我看到了, sorry....... 不用回應. ( 有很多個矩形, 都要這樣倒角嗎 ?? )

OK 了, 我會的就是寫一個小 VBA 程式免費提供, 參考一下!!

shackle_2005 寫到:OK 了, 我會的就是寫一個小 VBA 程式免費提供, 參考一下!!

AutoCAD預設需要使用者自行更改，再不然就得靠程式解決!
 

再修正一次, 按 Enter 跟上次一樣半徑......... ( 修正版, 按 0 結束程式!! Orz.......... )

Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集

Option Explicit

Public Sub alternate_fillet()

'ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr ' 設 undo, be, e 可以快速恢復圖面原狀
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr ' 設為世界座標

On Error Resume Next

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Dim fillet_radius As Integer
Dim first_obj As AcadObject
Dim second_obj As AcadObject
Dim pick_p As Variant
Dim inputString As String

fillet_radius = 10

Do While True

Err.Clear

fillet_radius = tu.GetReal("請輸入半徑 : " & " (預設半徑_確定(Enter) = " & _
fillet_radius & " / 請輸入 0 結束程式) : ................")
If Err Then
If InStr(Err.Description, "使用者輸入") <> 0 Then Err.Clear
End If

If fillet_radius = 0 Then Exit Do

tu.GetEntity first_obj, pick_p, "請選擇第一個物件!!........."

If Err Then GoTo one_more_time

tu.GetEntity second_obj, pick_p, "請選取第二個物件!!........."

If Err Then GoTo one_more_time

ThisDrawing.SendCommand "fillet" & vbCr & "r" & vbCr & Trim(Str(fillet_radius)) & vbCr & _
handle_ent_obj(first_obj) & vbCr & handle_ent_obj(second_obj) & vbCr
one_more_time:

Loop

'ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr

End Sub

Private Function handle_ent_obj(entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
handle_ent_obj = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

改好了, 原式碼把 Acad 全改成 Zcad 就可以, 但反應有點不一樣.........

另外補充

1. 可以把程式放進"載入應用程式", 這樣每次開啟軟體就會自動載入這個程式 alternate_fillet.

2. 在"自定工具"可以產生新的工具列, 例如叫"VBA"用來製作按鈕點擊就可以叫 VBA 程式.

3. 在 VBA 工具列應該可以隨便拉一個指令來製作按鈕.

4. 再把按鈕裏面的指令改成 ^C^C (command "vbarun" "alternate_fillet")

5. 這樣點擊這個按鈕應該就可以執行程式.

6. Thanks.

' *** 新修正比較簡單版 alternate_fillet **********

Public tm As ZcadModelSpace
Public tu As ZcadUtility

Option Explicit

Public Sub alternate_fillet()

ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr ' 設為世界座標

On Error Resume Next

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Dim fillet_radius As Integer
Dim first_obj As ZcadObject
Dim second_obj As ZcadObject
Dim pick_p As Variant
Dim inputString As String
Dim line_obj As ZcadLine

Do While True
 
  Err.Clear
 
  fillet_radius = tu.GetReal("請輸入半徑 : (請輸入 0 結束程式) ")
   
  If fillet_radius = 0 Then Exit Do

  tu.GetEntity first_obj, pick_p, "請選擇第一個物件!!........."
   
  If Err Then GoTo one_more_time
       
  first_obj.Highlight True
 
  tu.GetEntity second_obj, pick_p, "請選取第二個物件!!........."
 
  If Err Then GoTo one_more_time
 
  second_obj.Highlight True

  ThisDrawing.SendCommand "fillet" & vbCr & "r" & vbCr & Trim(Str(fillet_radius)) & vbCr & _
                  handle_ent_obj(first_obj) & vbCr & handle_ent_obj(second_obj) & vbCr
 
one_more_time:
 
Loop

first_obj.Highlight False: second_obj.Highlight False

End Sub

Private Function handle_ent_obj(entObj As ZcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
handle_ent_obj = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

好厲害 真的做到了, 只是一定要是線段才能做,請問能聚合線時也能做嗎?

不然遇到聚合線圖型每次一定要分解後 然後再串接.

' 還好我以前有處理過一次 ZWcad, 但覺得在 VBA 上不太好處理, 可能是所謂一分錢一分貨吧!! 請測試看看吧!! Thanks.

Public tm As ZcadModelSpace
Public tu As ZcadUtility

Option Explicit

Public Sub alternate_fillet()

ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr ' 設為世界座標

On Error Resume Next

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

Dim radius_str As String
Dim fillet_radius As Integer
Dim first_obj As ZcadObject
Dim second_obj As ZcadObject
Dim pick_p As Variant
Dim inputString As String
Dim line_obj As ZcadLine
Dim second_radius_str As String

Do While True
 
  Err.Clear
 
  radius_str = tu.GetString(False, "請輸入半徑或 [聚合線(P), 結束(0) : ")
   
  radius_str = UCase(Trim(radius_str))
   
  If radius_str = "P" Then
     second_radius_str = tu.GetString(False, "請輸入聚合線倒圓角的半徑 [結束(0)]")
     fillet_radius = second_radius_str
  Else
     fillet_radius = radius_str
  End If
     
  If fillet_radius = 0 Then Exit Do

  tu.GetEntity first_obj, pick_p, "請選擇第一個物件!!........."
   
  If Err Then GoTo one_more_time
       
  first_obj.Highlight True
 
  If radius_str <> "P" Then
 
     tu.GetEntity second_obj, pick_p, "請選取第二個物件!!........."
 
     If Err Then GoTo one_more_time
 
     second_obj.Highlight True
  End If
 
  If radius_str = "P" Then
     
     ThisDrawing.SendCommand "fillet" & vbCr & "p" & vbCr & handle_ent_obj(first_obj) & vbCr
     
  Else
     ThisDrawing.SendCommand "fillet" & vbCr & "r" & vbCr & Trim(Str(fillet_radius)) & vbCr & _
                  handle_ent_obj(first_obj) & vbCr & handle_ent_obj(second_obj) & vbCr
  End If
 
one_more_time:
 
Loop

first_obj.Highlight False: second_obj.Highlight False

End Sub

Private Function handle_ent_obj(entObj As ZcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
handle_ent_obj = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function