块内属性值求和返回并修改另一块的属性值 (测试图已上传)

dennylaw163 · 发表于 2013-5-23 12:00:39

本帖最后由 dennylaw163 于 2013-5-24 15:21 编辑

请各位高手帮忙用LISP编个小程序,如图,块B,块C,块D是同名块,其中值C为数值,希望实现在同一图纸中自动搜寻块B,C,D.....然后自动求所有值C的和并返回块A的值E. 谢谢!!

dennylaw163 · 发表于 2013-5-23 15:05:58

;前面的搞出来了,块B,C,D的名叫 part-row, 请高手搞一下后面的.

(defun c:AS ( / _assoc+ doc space ss n lst pt )
(vl-load-com)
(defun _assoc+ ( key value lst )
(
(lambda ( pair )
(if pair
(subst (list key (+ (cadr pair) value)) pair lst)
(cons (list key value) lst)
)
)
(assoc key lst)
)
)
(cond
(
(not
(vlax-method-applicable-p
(setq space
(vlax-get-property
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
)
)
'AddTable
)
)
(princ "\n** This Version of AutoCAD Does not Support Tables **")
)
(
(and (ssget (list'(0 . "INSERT") (cons 2 "part-row")))
(progn
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
(mapcar
(function
(lambda ( attrib )
(if (setq n (distof (vla-get-TextString attrib)))
(setq lst (_assoc+ (vla-get-TagString attrib) n lst))
)
)
)
(vlax-invoke obj 'GetAttributes)
)
)
(vla-delete ss)
(setq lst (mapcar '(lambda ( x ) (list (car x) (rtos (cadr x)))) lst))
)

(defun c:AS ( / _assoc+ doc space ss n lst pt ) 
  (vl-load-com) 
  (defun _assoc+ ( key value lst ) 
    ( 
      (lambda ( pair ) 
        (if pair 
          (subst (list key (+ (cadr pair) value)) pair lst) 
          (cons  (list key value) lst) 
        ) 
      ) 
      (assoc key lst) 
    ) 
  ) 
 
  (cond 
    ( 
      (not 
        (vlax-method-applicable-p 
          (setq space 
            (vlax-get-property 
              (setq doc 
                (vla-get-ActiveDocument 
                  (vlax-get-acad-object) 
                ) 
              ) 
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace) 
            ) 
          ) 
          'AddTable 
        ) 
      ) 
 
      (princ "\n** This Version of AutoCAD Does not Support Tables **") 
    ) 
    ( 
      (and (ssget (list'(0 . "INSERT") (cons 2 "part-row"))) 
        (progn 
          (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc)) 
            (mapcar 
              (function 
                (lambda ( attrib ) 
                  (if (setq n (distof (vla-get-TextString attrib))) 
                    (setq lst (_assoc+ (vla-get-TagString attrib) n lst)) 
                  ) 
                ) 
              ) 
              (vlax-invoke obj 'GetAttributes) 
            ) 
          ) 
          (vla-delete ss) 
          (setq lst (mapcar '(lambda ( x ) (list (car x) (rtos (cadr x)))) lst)) 
        )

004 · 发表于 2013-5-23 21:13:36

传个测试图吧。

dennylaw163 · 发表于 2013-5-23 21:32:03

还没有完成呢

dennylaw163 · 发表于 2013-5-24 08:24:55

本帖最后由 dennylaw163 于 2013-5-24 08:35 编辑

004 发表于 2013-5-23 21:13
传个测试图吧。

请帮我看一下如何返回如上图中值C的总和值,第52行返回一个列表(Tag,10),其中Tag是块的是标示,10是运算出来的总和,现在想设一个lst3的值只是后面的总合,请问怎么可以实现?

(defun c:Anew ( / _assoc+ doc space ss n lst pt )
(vl-load-com)
(defun _assoc+ ( key value lst )
(
(lambda ( pair )
(if pair
(subst (list key (+ (cadr pair) value)) pair lst)
(cons (list key value) lst)
)
)
(assoc key lst)
)
)
(cond
(
(not
(vlax-method-applicable-p
(setq space
(vlax-get-property
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
)
)
'AddTable
)
)
)
(
(and (ssget "_x" (list'(0 . "INSERT") (cons 2 "part-row")))
(progn
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
(mapcar
(function
(lambda ( attrib )
(if (setq n (distof (vla-get-TextString attrib)))
(setq lst (_assoc+ (vla-get-TagString attrib) n lst))
)
)
)
(vlax-invoke obj 'GetAttributes)
)
)
(vla-delete ss)
(setq lst (mapcar '(lambda ( x ) (list (car x) (rtos (cadr x)))) lst))
)
(setq lst2 (cdr lst))
(setq pt (getpoint "\nPick Point for Table: "))
)
)
)
(vl-cmdf ".insert" "rev" "S" "1" pt "0" 返回值)
(princ)
)

(defun c:Anew ( / _assoc+ doc space ss n lst pt ) 
  (vl-load-com) 
  (defun _assoc+ ( key value lst ) 
    ( 
      (lambda ( pair ) 
        (if pair 
          (subst (list key (+ (cadr pair) value)) pair lst) 
          (cons  (list key value) lst) 
        ) 
      ) 
      (assoc key lst) 
    ) 
  ) 
 
  (cond 
    ( 
      (not 
        (vlax-method-applicable-p 
          (setq space 
            (vlax-get-property 
              (setq doc 
                (vla-get-ActiveDocument 
                  (vlax-get-acad-object) 
                ) 
              ) 
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace) 
            ) 
          ) 
          'AddTable 
        ) 
      ) 
 
          ) 
    ( 
      (and (ssget "_x" (list'(0 . "INSERT") (cons 2 "part-row"))) 
        (progn 
          (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc)) 
            (mapcar 
              (function 
                (lambda ( attrib ) 
                  (if (setq n (distof (vla-get-TextString attrib))) 
                    (setq lst (_assoc+ (vla-get-TagString attrib) n lst)) 
                  ) 
                ) 
              ) 
              (vlax-invoke obj 'GetAttributes) 
            ) 
          ) 
          (vla-delete ss) 
          (setq lst (mapcar '(lambda ( x ) (list (car x) (rtos (cadr x)))) lst)) 
        ) 
           (setq lst2 (cdr lst)) 
        (setq pt (getpoint "\nPick Point for Table: ")) 
      ) 
         ) 
  ) 
 
  (vl-cmdf ".insert" "rev" "S" "1" pt "0" 返回值) 
 
  (princ) 
)

crtrccrt · 发表于 2013-5-24 08:30:35

一个字
很好

dennylaw163 · 发表于 2013-5-24 08:37:01

crtrccrt 发表于 2013-5-24 08:30
一个字
很好

看看5楼的回复,能帮我整整不?

zymywz · 发表于 2022-4-2 16:37:32

楼主，弄好了吗？

zymywz · 发表于 2022-4-2 16:42:56

大侠些，有没有这种现成的求多个相同块中某个数值的和，插入到指定位置？求分享一个，感激不尽。

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

[提问] 块内属性值求和返回并修改另一块的属性值 (测试图已上传)

本帖子中包含更多资源