lisp嵌套块的帮助
大家好，我有一个lisp用于使用属性，但这个lisp不能用于嵌套块，有人能告诉我如何解决这个问题吗。
;;local defun
;;helper method to group a list of items by their tags
(defun group-by-car (lst)
;;ensure that the list is not empty
(if lst
(cons
(vl-remove-if-not
;;this is a lambda function to compare the equality of the tags
(function (lambda (x)
(equal (car x) (caar lst) 0.00001)))
lst
)
;;recursive call to group a sublist
(group-by-car
(vl-remove-if
(function (lambda (x)
(equal (car x) (caar lst) 0.00001)))
lst))))
)
;;main program
;;define the main function, localize all variables.
(defun C:SUMTABLE (/ acsp att atts block_obj data en ent_list item
match_list pt sset tag tags tmp)
;;look for block
(if (not (tblsearch "block" "GKW_Totaal"))
(progn
;;if it is not found, alert user and exit program
(alert "Block \"GKW_Totaal\" does not exist. Exit program.")
(exit)(princ))
)
(setq acsp (vla-get-block ;;get the block representation of the layout
(vla-get-activelayout ;;get the current layout
(vla-get-activedocument ;;get the current drawing
(vlax-get-acad-object)))) ;;get AutoCAD application
)
;;create a list to match attribute tags
(setq match_list (list "GKW" "FLOW" "KPA"))
;;get a selection set of all blocks with attributes
(setq sset (ssget (list (cons 0 "INSERT") (cons 66 1)))
)
;;start to loop through selection set
(while (setq en (ssname sset 0))
;;add current entity to a list of entities
(setq ent_list (cons en ent_list))
;;get the first attribute from the entity
(setq att (entnext en))
;;start while loop through attributes in the block
(while (/= (cdr (assoc 0 (entget att))) "SEQEND")
;;if there is an attribute
(if (and att
;;AND its tag is in the list of tags to match
(member (setq tag (cdr (assoc 2 (entget att)))) match_list))
;;then get the value from the tag and place into a dotted pair list
(setq tags (cons (cons tag (cdr (assoc 1 (entget att)))) tags)))
;;get the next attribute
(setq att (entnext att)))
;;deletes an entity from the current selection set
(ssdel en sset)
)
;;loop through each pair of dotted pairs in the tags list
(foreach item (group-by-car tags)
;;if the tag is KPA...
(if (eq (caar item) "KPA")
;;get the maximum for KPA
(setq tmp (list (caar item)
(vl-princ-to-string (apply 'max (mapcar 'atof (mapcar 'cdr item))))))
;;otherwise, sum all other values together
(setq tmp (list (caar item)
(vl-princ-to-string (apply '+ (mapcar 'atof (mapcar 'cdr item))))))
)
;;NOTE: mapcar is used to apply a function to a list of items. The function is applied
;;to every item in the list. atof will turn a string into a real number
;;add the computed values to a list
(setq data (cons tmp data)
)
)
;;turn all values into strings, rtos is used to accomplish this
(setq data (mapcar (function (lambda(x)
(cons (car x)
(rtos (atoi (cadr x)) 2 0))))
data
)
)
;;prompt user for an insertion point
(setq pt (getpoint "\nSpecify insertion point of the block: ")
)
;;insert a block with a scale of 1 and rotation of 0
(setq block_obj (vlax-invoke acsp 'Insertblock pt "GKW_Totaal" 1 1 1 0))
;;get the attributes for the inserted block
(setq atts (vlax-invoke block_obj 'GetAttributes))
;;loop through the attributes in the inserted block
(foreach att atts
;;if the tag for the attribute is found...
(if (setq item (assoc (vla-get-tagstring att) data))
;;put the value into the attribute
(vla-put-textstring att (cdr item)))
)
;;silent exit
(princ)
)
;;inform the user how to start the program
(prompt "\n\t\t***\tType SUMTABLE to execute\t***")
(prin1)
;;load VL* functions
(vl-load-com)
破译一个程序充其量是一项乏味的任务。
提供更多细节将帮助人们真正解决你的问题。
你能简单描述一下吗
1、你想要实现什么？
2.到底出了什么问题？
也许可以举一个原始绘图的例子，一个带有预期结果的绘图和一个显示您实际获得的结果的绘图可能会有很大的帮助。
这可能是一个很好的起点。人们可能需要您提供的更多详细信息。
这样，我们将更容易配置问题的可能解决方案。
如果您还没有找到解决方案，请提供这些详细信息。
-桑杰·库尔卡尼 我们正在做的是在天花板瓷砖中放置一个冷却系统，瓷砖是一个块，冷却是一个动态块，安装在瓷砖中并保存为一个新的wblock，上面的程序将一起计算值（解决后，我需要用更多公式对此进行调整），请参阅图纸示例。
testplafond。图纸
GKW_Totaal。图纸
页:
[1]