[求助]如何生成闭合多段线？

neteasy

类似CAD自带的边界图案填充命令，拾取点或选择对象时生成闭合多段线，但是源对象不要删除，遇到圆弧时自动用一定数量的线段来代替，线段的长度由用户输入。应该如何编写，或者提供一下思路。

alin

Just for your reference...It's a reply from Joe Parker Re: Create Boundary
counting the modelspace objects before and after a call to this sub will
tell you if there are any new polylines created- messy but it works
Private Sub Bound()
Dim Pt As Variant, gotpt As Boolean
gotpt = False

Do
On Error Resume Next
Pt = ThisDrawing.Utility.GetPoint(, "Select an Internal Point")
If Err Then
If GetAsyncKeyState(VK_ESCAPE) And &H8000& Then
Exit Function
End If
Err.Clear
gotpt = False
Else
gotpt = True
End If
Loop While Not gotpt
On Error GoTo 0
ThisDrawing.SendCommand Chr(3) & Chr(3) & "-boundary" & vbCr & Pt(0) & "," &
Pt(1) & vbCr & vbCr
End Sub

neteasy

GetAsyncKeyState这个函数没有定义

alin

Option Explicit
Private Const VK_ESCAPE = &H1B
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer Private Sub Bound()
Dim Pt As Variant, gotpt As Boolean
gotpt = False Do
On Error Resume Next
Pt = ThisDrawing.Utility.GetPoint(, "Select an Internal Point")
If Err Then
If GetAsyncKeyState(VK_ESCAPE) And &H8000& Then
Exit Sub
End If
Err.Clear
gotpt = False
Else
gotpt = True
End If
Loop While Not gotpt
On Error GoTo 0
ThisDrawing.SendCommand Chr(3) & Chr(3) & "-boundary" & vbCr & Pt(0) & "," & _
Pt(1) & vbCr & vbCr
End Sub

neteasy

多谢版主的回复，但是程序只相当于正常的边界命令，还达不到我的要求，能否改进一下？谢谢！

neteasy

怎么没人知道吗？

neteasy

再顶一次。

QQ873240166

NNWS神速神速