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))
      )

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 http://bbs.mjtd.com/static/image/common/back.gif
传个测试图吧。

请帮我看一下如何返回如上图中值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)
)

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

一个字
很好

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

crtrccrt 发表于 2013-5-24 08:30 static/image/common/back.gif
一个字
很好

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

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

楼主，弄好了吗？

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


大侠些，有没有这种现成的求多个相同块中某个数值的和，插入到指定位置？求分享一个，感激不尽。
页: [1]
查看完整版本: 块内属性值求和返回并修改另一块的属性值 (测试图已上传)