社区 › VB › [求助]如何生成闭合多段线？

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

neteasy 发表于 2005-3-24 19:41:00

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

neteasy 发表于 2005-3-30 22:46:00

怎么没人知道吗？

neteasy 发表于 2005-4-10 20:51:00

再顶一次。

QQ873240166 发表于 2020-3-29 23:09:00

NNWS神速神速

查看完整版本: [求助]如何生成闭合多段线？