社区 › VB › VBA中的边界多边形

JohnF 发表于 2007-1-22 02:22:09

VBA中的边界多边形

有人在VBA中创建代码来匹配边界多段线命令吗
我搜索了一下，什么也没有找到——只有唐；我不想重建轮子。

Tuoni 发表于 2007-1-22 04:34:24

根据我的经验，只有两种方法可以做到这一点（或类似的方法）
一种是从多段线创建区域，然后使用布尔（我的意思是在减法等中）来生成所需形状的区域，或者使用良好的ol&#039；SendCommand*抖动*
有关此示例，请检查此处：http://discussion.autodesk.com/thread.jspa?messageID=415313

Tuoni 发表于 2007-1-29 17:47:30

这应该做的伎俩和更多…我做了这个计算领域。只需将其复制到你的应用程序中，按下命令按钮，运行它，然后在关闭的（）内单击你想要的区域
私有子cmdArea\u Click（）
Me。隐藏Dim Pt作为变量，gotpt作为布尔值
gotpt=False
Do
On Error Resume Next
Pt=ThisDrawing.Utility。GetPoint（，“选择内部点”）
如果出错，则出错。清除gotpt=False
Else
gotpt=True
结束If>。SendCommand Chr（3）&amp；Chr（3）&amp&引用-“边界”&amp；vbCr&amp；Pt（0）&amp&quot&引用&amp；第（1）部分和；vbCr&amp；vbCr''''''''''''''
本图纸。SendCommand“_面积“&amp；vbCr&amp&引用；“对象”&amp；vbCr&amp&引用；最后一个“&amp；vbCr变面积_面积“&amp；vbCr&amp&引用；“对象”&amp；vbCr&amp&引用；最后一个“&amp；vbCr本图。SendCommand“；删除“&amp；vbCr&amp&引用；最后一个“&amp；vbCr&amp；vbCr'''''''''''''''''
&039'''''''''''''''''
Dim SysVarName作为字符串；DIMSCALE“
sysVarName2=；面积“
VarData=ThisDrawing。GetVariable（SysVarName）
varArea=Round（Val（ThisDrawing.GetVariable（sysVarName2））/144，0）&amp&引用；平方英尺“
intData=VarData*0.09375#039；对于3/32文本，将文本对象设置为AcadText，将文本设置为变量，将高度设置为变量。添加文本（varArea，Pt，Height）
End Sub

Tuoni 发表于 2007-1-30 04:06:30

这里是经过轻微编辑的版本，仅在2005年测试Option Explicit
'| request check "Break on Unhandled Errors"
'| in Tools -> References -> Options -> General tab
'| -> Error Trapping field
'|---------------------------------------------------|
Private Sub cmdArea_Click()
   Me.Hide
   Dim Pt As Variant, _
         varArea As String, _
         pstr As String, _
         SysVarName As String, _
         sysVarName2 As String, _
         VarData As Variant, _
         intData As Double, _
         textObj As AcadText, _
         text As Variant, _
         Height As Variant, _
         Msg As String
   SysVarName = "DIMSCALE"
   sysVarName2 = "AREA"
   With ThisDrawing
          .SetVariable "OSMODE", 0
          .SetVariable "CMDECHO", 0
          '' Multiple getpoint method by Tony Tanzillo
          Msg = vbCrLf & "Select an Internal Point"
          Do
               On Error Resume Next
               Pt = .Utility.GetPoint(, Msg)
               If Err Then
                  Err.Clear
                  Exit Do
               End If
               On Error GoTo 0
               pstr = Replace(CStr(Pt(0)), ",", ".") & "," & _
                      Replace(CStr(Pt(1)), ",", ".")
               .SendCommand Chr(3) & Chr(3) & "._-boundary" & vbCr & pstr & vbCr & vbCr
               .SendCommand "._area" & vbCr & "_Object" & vbCr & "_Last" & vbCr
               .SendCommand "._erase" & vbCr & "_Last" & vbCr & vbCr
               VarData = .GetVariable(SysVarName)
               varArea = Round(Val(.GetVariable(sysVarName2)) / 144, 2) & " Sq. Ft."
               intData = VarData * 0.09375   'for 3/32 text
               Height = intData
               Set textObj = .ModelSpace.AddText(varArea, Pt, Height)
               textObj.Update
               Msg = vbCrLf & "Next Internal Point or ENTER to exit: "
          Loop
          On Error GoTo 0
          .SetVariable "OSMODE", 703
          .SetVariable "CMDECHO", 1
   End With
   MsgBox "Done"
   Unload Me
End Sub
~&039；J#039~

Tuoni 发表于 2007-1-30 10:17:10

谢谢胖子，那&#039；甚至更好！

Tuoni 发表于 2007-1-30 18:02:48

C#039；我只是用了你的代码，不过没什么大不了的；J#039~

查看完整版本: VBA中的边界多边形