[编程交流] 如何添加带填充的多段线

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 [url="http://www.cadtutor.net/forum/member.php?u=210"]fixo[/url]
'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