注册 登录
明经CAD社区 返回首页

charlesli8的个人空间 http://www.mjtd.com/?7305579 [收藏] [复制] [分享] [RSS]

日志

分离CAD对象,并将cad对象分类,依次输出各种cad的总长

已有 710 次阅读2014-12-19 22:43 |个人分类:插件|系统分类:开发| 分离对象

Option Explicit

'创建选择集
Public Function createSSet(ByVal SSetName As String) As AcadSelectionSet
    Dim SSet As AcadSelectionSet
    Dim i As Integer
    For i = 0 To ThisDrawing.SelectionSets.Count - 1
        Set SSet = ThisDrawing.SelectionSets.Item(i)
        If StrComp(SSet.Name, SSetName, vbTextCompare) = 0 Then
            SSet.Delete
            Exit For
        End If
    Next i
    Set createSSet = ThisDrawing.SelectionSets.Add(SSetName)
End Function

Public Sub demoAddSSet()
    Dim ss As AcadEntity
    Dim c As AcadCircle
    Dim a As AcadLine
    Dim b As AcadArc
    Dim d As AcadLWPolyline
    Dim cc As Double
    Dim dd As Double
    Dim ee As Double
    Dim ff As Double
    cc = 0: dd = 0: ee = 0: ff = 0
    Dim SSet As AcadSelectionSet
    Set SSet = createSSet("mySelectionSet")
    SSet.SelectOnScreen
 For Each ss In SSet
   If TypeOf ss Is AcadCircle Then
   cc = cc + ss.Circumference
   ElseIf TypeOf ss Is AcadLine Then
   dd = dd + ss.Length
   ElseIf TypeOf ss Is AcadArc Then
   ee = ee + ss.ArcLength
   ElseIf TypeOf ss Is AcadLWPolyline Then
   ff = ff + ss.Length
   End If
 Next
 MsgBox "所有圆的周长:" & cc & "   " & Chr(10) & "所有线段总长:" & dd & "   " & Chr(10) & "所有圆弧总长:" & cc & "   " & Chr(10) & "所有多段线总长:" & cc & "   "
End Sub


路过

雷人

握手

鲜花

鸡蛋

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-2 12:39 , Processed in 5.521522 second(s), 16 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部