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

neteasy · 发表于 2005-3-19 20:17:00

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

alin · 发表于 2005-3-23 08:16:00

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 · 发表于 2005-3-23 20:22:00

GetAsyncKeyState这个函数没有定义

alin · 发表于 2005-3-23 22:16:00

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