[求助]：求CAD中数据求和程序

zcf108 · 发表于 2006-11-10 16:26:47

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

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

×

求CAD中数据求和程序
搜索也搜索不到有关的程序,那位朋友有的请给一个呀.

qjcpj · 发表于 2006-11-10 20:10:59

我编写过一个针对“TEXT”实体数据求和程序，不知符合你要求否？

;;;=========================================================================================
;;;
;;; Program name: SUM.LSP
;;; Useage: 1. 区域求和
;;; 2. 适用于AutoCAD R14及以上版本
;;; Created 10.05.2006
;;; By qjcpj ,Qujing,Yunnan, Republic of China .
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; Copyright(C), QJCPJ, ALL RIGHTS RESERVED.
;;;
;;; 本软件仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
;;; 用途之适应性, 以及商业销售所隐含出具的保证, 在此一概予以否认。
;;;
;;; Add:№18 East Road Jiaochang Qujing,Yunnan China.
;;;
;;;=========================================================================================
(defun c:sum (/ cnt cnt2 ent ent2 ent_str num num2 ss ssl sum)
(setq ss (ssget (list (cons 0 "*TEXT"))))
(if ss
(progn
(setq num (sslength ss))
(setq cnt 0)
(setq ssl (ssadd))
(repeat num
(setq ent (ssname ss cnt))
(setq ent_str (cdr (assoc '1 (entget ent))))
(if (= ent_str (rtos (atof ent_str)))
(ssadd ent ssl)
)
(setq cnt (1+ cnt))
)
(setq num2 (sslength ssl))
(if (> num2 0)
(progn
(setq cnt2 0
sum 0.0
)
(repeat num2
(setq ent2 (ssname ssl cnt2))
(setq sum (+ (atof (cdr (assoc '1 (entget ent2)))) sum))
(setq cnt2 (1+ cnt2))
)
)
(setq sum 0.0)
)
(alert (strcat "\n所求区域 ∑ Sum = " (rtos sum) "。"))
(princ "\n所求区域∑Sum = ")(princ (rtos sum))
)
(alert "\n未选中有效文字实体！")
)
(princ)
)

;;;========================================================================================= 
;;;                                                                                          
;;;    Program name: SUM.LSP                                                                
;;;    Useage: 1. 区域求和                                                                   
;;;            2. 适用于AutoCAD R14及以上版本                                                
;;;    Created 10.05.2006                                                                   
;;;               By qjcpj ,Qujing,Yunnan, Republic of China .                               
;;;                                                                                          
;;;    Permission to use, copy, modify, and distribute this software                         
;;;    for any purpose and without fee is hereby granted, provided                           
;;;    that the above copyright notice appears in all copies and                            
;;;    that both that copyright notice and the limited warranty and                         
;;;    restricted rights notice below appear in all supporting                               
;;;    documentation.                                                                        
;;;                                                                                          
;;;    Copyright(C), QJCPJ, ALL RIGHTS RESERVED.                                             
;;;                                                                                          
;;;   本软件仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊                     
;;;   用途之适应性, 以及商业销售所隐含出具的保证, 在此一概予以否认。                         
;;;                                                                                          
;;;    Add:№18 East Road Jiaochang Qujing,Yunnan China.                                     
;;;                                                                                          
;;;========================================================================================= 
 
(defun c:sum        (/ cnt cnt2 ent ent2 ent_str num num2 ss ssl sum) 
        (setq ss (ssget (list (cons 0 "*TEXT")))) 
        (if        ss 
                (progn 
                        (setq num (sslength ss)) 
                        (setq cnt 0) 
                        (setq ssl (ssadd)) 
                        (repeat        num 
                                (setq ent (ssname ss cnt)) 
                                (setq ent_str (cdr (assoc '1 (entget ent)))) 
                                (if        (= ent_str (rtos (atof ent_str))) 
                                        (ssadd ent ssl) 
                                ) 
                                (setq cnt (1+ cnt)) 
                        ) 
                        (setq num2 (sslength ssl)) 
                        (if        (> num2 0) 
                                (progn 
                                        (setq        cnt2 0 
                                                                sum        0.0 
                                        ) 
                                        (repeat        num2 
                                                (setq ent2 (ssname ssl cnt2)) 
                                                (setq sum (+ (atof (cdr (assoc '1 (entget ent2)))) sum)) 
                                                (setq cnt2 (1+ cnt2)) 
                                        ) 
                                ) 
                                (setq sum 0.0) 
                        ) 
                        (alert (strcat "\n所求区域 ∑ Sum = " (rtos sum) "。")) 
                        (princ "\n所求区域∑Sum = ")(princ (rtos sum)) 
                ) 
                (alert "\n未选中有效文字实体！") 
        ) 
        (princ) 
)

mengjinhua · 发表于 2006-11-10 20:35:54

搂主能告诉我如何安装ADT2007吗，我安装后出现缺少MSVCP71.dll文件要求重装。我已经装了三次了。到底是这么回事。我的系统是winxp，adt2006,cad2007都已安装。切盼搂主能赐教。

zcf108 · 发表于 2006-11-11 11:34:37

没用过ADT2007,不好意思帮不了你呀

leept · 发表于 2006-11-13 09:45:40

我也需要啊，2楼的能不能直接上传SUM.LSP附件。

qjcpj · 发表于 2006-11-13 13:02:22

最初由 leept 发布
[B]我也需要啊，2楼的能不能直接上传SUM.LSP附件。 [/B]

拷贝并粘贴至记事本中，另存为*.lsp即可。

83517895 · 发表于 2013-7-25 00:04:20

看看，不错

账号		自动登录	找回密码
密码			立即注册

[求助]：求CAD中数据求和程序

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

相关帖子