如何添加带填充的多段线
我所做的是在屏幕上选取一条多段线，然后对其边缘进行圆角，并将其添加到块中。我了解了如何对边进行圆角，但不知道如何将其添加到具有圆角边的块中：/Public Sub bar()
'Checking for existing blocks
Dim objBlock As AcadBlock
Dim strBlockList As String
Dim n As Integer
n = -3
strBlockList = "List of blocks: "
For Each objBlock In ThisDrawing.Blocks
n = n + 1
strBlockList = strBlockList & vbCr & objBlock.Name
Next
MsgBox strBlockList
' MsgBox n
'**********copied from fixo
'FILLET
Dim oPline As AcadLWPolyline
Dim varPt As Variant
On Error GoTo Error_Trapp
ThisDrawing.Utility.GetEntity oPline, varPt, "Select polyline"
If Err Then
Err.Clear
Exit Sub
ElseIf Not TypeOf oPline Is AcadLWPolyline Then
MsgBox "This is not a LightWeightPolyline"
Else
Dim filrad As Double
filrad = 10 ' CDbl(InputBox(vbCr & vbCr & "Specify fillet radii: ", "Filleting LWPolyline", "10,0"))
ThisDrawing.SetVariable "FILLETRAD", filrad
Dim commStr As String
commStr = "_FILLET _P " & _
"(handent " & Chr(34) & oPline.Handle & Chr(34) & ")" & vbCr ' I have to admit I don't understand this row
ThisDrawing.SendCommand commStr
End If
Error_Trapp:
If Err.Number = 13 Then
MsgBox "This is not a polyline" & vbCr _
& "Error number: " & Err.Number & vbCr & Err.Description
End If
'''*********^^^THIS IS NOT MINE. I've copied it form some board and it works
'adding LWPolyline to block
Dim Cordinat As Variant
Cordinat = oPline.Coordinates
Dim indeks As Integer
Dim UpperBoundery As Integer
Dim LowerBoundery As Integer
UpperBoundery = UBound(Cordinat)
LowerBoundery = LBound(Cordinat)
Do
If l > UpperBoundery Then
Exit Do
End If
'MsgBox Cordinat(l)
l = l + 1
Loop
Dim objBlockName As String
Dim dblOrigin(2) As Double
objBlockName = "bar" & n
Set objBlock = ThisDrawing.Blocks.Add(varPt, objBlockName)
objBlock.AddLightWeightPolyline Cordinat
End Sub 嗨，亲爱的Rojek
请转到此链接并下载所需的工具：
http://www.visiblevisual.com/index.php/AutoCad-VB/VBA/database-driven-block-manager.html
圣诞快乐，祝你度过愉快的一天
页:
[1]