首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >AutoLisp -两个基本函数:确定块属性的数量和值​

AutoLisp -两个基本函数:确定块属性的数量和值​
EN

Stack Overflow用户
提问于 2022-01-17 01:50:17
回答 1查看 519关注 0票数 1

我必须编写一个函数来确定AutoLisp中块属性的数量和值​​。我有计算分配数的函数:

代码语言:javascript
运行
复制
(defun c:Test (/ s ss)
  (if (and (princ "\n Select FIRST Attributed Block :")
           (setq s (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
           (princ "\n Select the SECOND Attributed Block :")
           (setq ss (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
      )
    (mapcar
      'length
      (mapcar
        '(lambda (a)
           (mapcar
             '(lambda (x) (vla-get-textstring x))
             (vlax-invoke (vlax-ename->vla-object a) 'getattributes)
           )
         )
        (list (ssname s 0) (ssname ss 0))
      )
    )
  )
)**

返回属性值​​的函数:

代码语言:javascript
运行
复制
(defun c:Test (/ ss n e x)
  (while (progn (princ "\n Select single attributed block :")
                (setq ss (ssget "_+.:S" '((0 . "INSERT") (66 . 1))))
         )
    (setq n (entnext (ssname ss 0)))
    (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND" ))
       (if (eq (cdr (assoc 0 e)) "ATTRIB")
         (print (cdr (assoc 1 e)))
       )
       (setq n (entnext n))
    )
  )
  (princ)
)

你能帮我把这个和功能结合在一起吗?

EN

回答 1

Stack Overflow用户

发布于 2022-01-31 16:55:02

下面是一个lisp程序,它将遍历用户选择集中的所有块,并且:

1.)打印块名

2.)打印AttributeTag.AttributeValue的关联列表

3.)打印AttributeTags列表

4.)打印AttributeValues列表

5.)打印AttributeValues的编号

我还附加了命令行输出应该是什么样子。

Lisp命令行输出

代码语言:javascript
运行
复制
;;www.cadwiki.net

(defun c:test (/ SSINPUT)
  (setq ssInput (ssget (list '(0 . "insert"))))
  (PRINT-BLOCK-ATTRIBUTE-INFO ssInput)
  (princ)
)


(defun PRINT-BLOCK-ATTRIBUTE-INFO (ssInput / ATTRIBUTETAGS ATTRIBUTETAGSTOVALUES ATTRIBUTEVALUES BLOCKENTITY BLOCKVLAOBJECT I NUMBEROFBLOCKATTRIBUTES
                                  )
  (setq i 0)
  (if (= ssInput nil)
    (progn
      (princ "ssInput was nothing, exiting.")
      (exit)
    )
  )
  (princ (strcat "\nItems in selection set: " (itoa (sslength ssInput))))
  (while (< i (sslength ssInput))
    (setq blockEntity (ssname ssInput i))
    (setq blockVlaObject (vlax-ename->vla-object blockEntity))
    (setq attributeTagsToValues (GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC blockEntity))
    (princ (strcat "\nBlock name: " (vla-get-name blockVlaObject)))
    (princ "\nBlock attributes tag to values association list: ")
    (princ attributeTagsToValues)
    (setq attributeTags (GET-NTHS-FROM-LISTS 0 attributeTagsToValues nil))
    (princ "\nBlock attribute tags list: ")
    (princ attributeTags)
    (setq attributeValues (GET-LAST-ITEM-FROM-EACH-LIST attributeTagsToValues))
    (princ "\nBlock attributes values list: ")
    (princ attributeValues)
    (princ "\nNumber of block attributes: ")
    (setq numberOfBlockAttributes (itoa (length attributeValues)))
    (princ numberOfBlockAttributes)
    (setq i (+ i 1))
  )
)

(defun GET-NTHS-FROM-LISTS (N LSTs removeDuplicates / CT LST2 LST IT)
  (setq LST2 nil)
  (foreach LST LSTs
    (setq IT (nth N LST))
    (if removeDuplicates
      (if (not (member IT LST2))
        (setq LST2 (append LST2 (list IT)))
      )
      (setq LST2 (append LST2 (list IT)))
    )
  )
  LST2
)

(defun GET-LAST-ITEM-FROM-EACH-LIST (LSTs / CDRs FAIL LST)
  (setq CDRs nil
        FAIL nil
  )
  (if (not (= (type LSTs) 'LIST))
    (setq FAIL "not a list")
  )
  (if (not FAIL)
    (foreach LST LSTs
      (setq FAIL (cond
                   ((not (= (type LST) 'LIST)) "non-list member")
                   ((not (cdr LST)) "no CDR")
                   (T nil)
                 )
      )
      (if (not FAIL)
        (setq CDRs (append CDRs (list (cdr LST))))
      )
    )
  )
  CDRs
)

(defun GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC (entity / COUNTER COUNTER2 COUNTERMAX COUNTERMAX2 DXFCODE0 DXFCODE2 DXFCODE66 DXFCODE8 DXFCODECODE-1 ENTITIESTORETURN ENTITYDXFCODES *ERROR* RETURNLIST
                                                SUPPLIEDTRUENAME TRUENAME ATTRIBUTETAG ATTRIBUTEVALUE DXFCODE-1 ENTITYNAMEFORDRILLING SUBLIST TAGSANDVALUES THECALLINGFUNCTIONSNAME
                                               )

  (setq counter 0) ;initialize counter to 0 for while loop
  (if ;if
    (/= entity nil) ;entity is not nil
     (progn ;progn wrap
       (setq entityDxfCodes (entget entity)) ;set the varaible entityDxfCodes to the list of entities from the en varaible
       ;; you can use the method here to find any value from a dxfCodecode
       (setq dxfCode-1 (cdr (assoc -1 entityDxfCodes))) ;set dxfCode-1 to the second element of the item that has -1 as it's first element, this is the entity name
       (setq dxfCode0 (cdr (assoc 0 entityDxfCodes))) ;set dxfCode0 to the element of the item that has 0 as it's first element, this is the entity type
       (setq dxfCode2 (cdr (assoc 2 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the name, or block name
       (setq dxfCode8 (cdr (assoc 8 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the layer
       (setq dxfCode66 (cdr (assoc 66 entityDxfCodes))) ;set dxfCode66 to the second element of the item that has 66 as it's first element, this is the attribute flag
       (setq entityNameForDrilling entity)
       (if ;if start
         (= dxfCode66 1) ;entity attribute flag is 1
          (progn ;progn wrap
            (while (/= dxfCode0 "SEQEND") ;while loop to drill to each sub entity in a block
              (setq attributeTag (cdr (assoc 2 entityDxfCodes))) ;set attributeTag to the second element of the second Dxf code (assoc 2) of the entityDxfCodes variable
              (setq attributeValue (cdr (assoc 1 entityDxfCodes))) ;set attributeValue to the second element of the first Dxf code (assoc 1) of the entityDxfCodes variable
              (if
                (/= attributeValue nil)
                 (progn
                   (setq sublist (cons attributeTag attributeValue))
                   (setq tagsAndValues (cons sublist TagsAndValues))
                 )
              )
              (setq entityNameForDrilling (entnext entityNameForDrilling))
              (setq entityDxfCodes (entget entityNameForDrilling))
              (setq dxfCode0 (cdr (assoc 0 entityDxfCodes)))
            )
          ) ;progn wrap end
       ) ;if end
     ) ;progn wrap end
  ) ;if end
  (setq returnList tagsAndValues)
)
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/70735718

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档