找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 837|回复: 2

[VBA函数]:用属性块进行材料表统计

[复制链接]
发表于 2003-11-29 16:13:59 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
Sub cal()
Dim ent As Object
Dim attvar As Variant
Dim attri As String
Dim height As Double
Dim ss As AcadSelectionSet
Set ss = GetSelSet
    For Each ent In ss
        If TypeOf ent Is AcadBlockReference Then
            attvar = ent.GetAttributes
            height = ent.XScaleFactor
            End If
            attri = ""
Dim i As Integer
i = 0
    For i = LBound(attvar) To UBound(attvar)
Dim a As Double
Dim b As Double
Dim c As Variant
On Error Resume Next
    a = attvar(3).textString
    b = attvar(4).textString
    c = a * b
    attvar(5).textString = c
    e = c / 8
    d = d + e
    Next
    Next
Dim newtext As AcadText
Dim pt1 As Variant
On Error Resume Next
pt1 = ThisDrawing.Utility.GetPoint(, "总和插入点:")
Set newtext = ThisDrawing.ModelSpace.AddText(d, pt1, 3.5 * height)

Function GetSelSet() As AcadSelectionSet
    Dim ss As AcadSelectionSet
    Dim ssName As String
    ssName = "PICKFIRST"
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets.add(ssName)
    If Err Then
        Set ss = ThisDrawing.SelectionSets(ssName)
        ss.Delete
    End If
    Set ss = ThisDrawing.PickfirstSelectionSet
    If ss.Count = 0 Then
        Set ss = ThisDrawing.SelectionSets(ssName)
        If Err Then Set ss = ThisDrawing.SelectionSets.add(ssName)
        ss.Clear
        ss.SelectOnScreen
    End If
    Set GetSelSet = ss
    ThisDrawing.SetVariable "filedia", 1
End Function
本程序为用属性块进行材料表统计的程序,属性块为外部块,当数据输入完成后只需要用鼠标选取一下需要进行统计的材料就可以自动进行统计,并得出合计的结果。(但考虑到各人的情况不同,所以本程序只是给大家一个思路而已)
想查看本程序效果可下载附件后解压至cad安装目录下的support目录下并把下面这段文字拷贝进acad.mnl文件内。
(vl-load-com)
;;自动加载VBA程序的函数
(defun AutoVBALoad (cmdname project macro)
(eval
(list 'defun
(read (strcat "C:" cmdname))
nil
(list
'vl-vbarun
(strcat
project
"!"
(if macro
macro
cmdname
)
)
)
(princ)
)
)
)

(AutoVBALoad "cal" "cal.dvb" "cal")
如果已经有过这个函数定义,只需把(AutoVBALoad "cal" "cal.dvb" "cal")
复制到acad.mnl内即可,然后打开附件内的sample文件,运行cal选择材料表查看结果。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2003-11-29 16:14:51 | 显示全部楼层
使用演示
下载到硬盘进行全屏观看会比较清晰
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2018-10-27 16:13:30 | 显示全部楼层
没有看明白,怎么用呀!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-28 17:42 , Processed in 0.337343 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表