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

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:46

NNWS神速神速

页: [1]

明经CAD社区's Archiver

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