更改属性值错误

Ohnoto · 发表于 2022-7-6 09:31:28

我编译了以下LISP。虽然目前只有一个区块列在顶部，但还有15个区块可以用于我们使用的其他边界。

(defun c:AD (/ TodayDate str) 
(vl-load-com)                                        ;;; Do not forget to add
 (setq blocks
  '(
     "BORDER (ABOVENET) -BRC"
   )
 )
 
 (setq str
   (cond
     (
       (eq ""
         (setq str
           (getstring t
             (strcat "\nDate to be Placed <"
               (setq today (menucmd "m=$(edtime,$(getvar,DATE),MO/DD/YY)")) ">: "
             )
           )
         )
       )
       today
     )
     ( str )
   )
 )
 
  (AttribChng blocks "DATE" str)
 
  (princ "\n ----------------------------------------------")
  (princ (strcat "\n --------- Adjust Date - Version " ADTVerNum " ---------"))
  (princ (strcat "\n ---------------- Date: " str " --------------"))
  (princ "\n ----------------------------------------------")
  (princ)
  )
(defun AttribChng (blk tag val / ss)
 (vl-load-com)
 (mapcar (function set) '(blk tag)
         (mapcar (function strcase) (list blk tag)))
 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 (if (ssget "_X" (list '(0 . "INSERT") (cons 2 blocks) '(66 . 1)))
   (progn
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       (foreach att (vlax-invoke obj 'GetAttributes)
         (if (eq (strcase (vla-get-TagString att)) tag)
           (vla-put-TextString att val))))
     (vla-delete ss))
   (princ "\n** No Blocks Found **"))
 (princ))

然而，我得到一个错误：

错误的参数类型：stringp（“BORDER（overnet）-BRC”）

我不太确定如何修复它。

谢谢

LibertyOne · 发表于 2022-7-6 09:44:33

试试这个：

copy

  (setq blocks    (eval
    '(
     "BORDER (ABOVENET) -BRC"
    )
  )
)

AutoLisp解释器此时正在查找字符串，但它接收的是一个列表。你需要引用变量块吗？或者你可以写下来吗

copy

(setq blocks "BORDER (ABOVENET) -BRC")

Ohnoto · 发表于 2022-7-6 09:54:02

在第一个代码中，我得到了一个糟糕的函数错误。第二个可行，但我需要找到一种方法，使其适用于包含16个可能边界的列表。目前我们正在使用一个自定义字段，但如果有人进入块编辑器并在那里调整值（这已经是我们的过程一段时间了），它会否定LISP程序。

LibertyOne · 发表于 2022-7-6 09:57:31

我认为问题在于你试图构建的虚线对。

copy

(cons 2 blocks)

在这里，您必须传递一个块名。我不相信你能给出一个名单。在构造选择集时尝试集成OR过滤器。。我理解您试图完成的是从选择集中筛选出那些不在块列表中的块。

copy


(-4 . "<or") (2 . "BLOCK_NAME_01") (2 . "BLOCK_NAME_02") (2 . "BLOCK_NAME_03") (2 . "BLOCK_NAME_15") (-4 . "or>")

Lee Mac · 发表于 2022-7-6 10:08:57

问题是，您从这里获取的子函数仅用于单个块。

试试这个：

copy


(defun c:AD ( / blocks str today ) (vl-load-com) 
 (setq blocks
  '(
     "BORDER (ABOVENET) -BRC"
   )
 )
 
 (setq str
   (cond
     (
       (eq ""
         (setq str
           (getstring t
             (strcat "\nDate to be Placed <"
               (setq today (menucmd "m=$(edtime,$(getvar,DATE),MO/DD/YY)")) ">: "
             )
           )
         )
       )
       today
     )
     ( str )
   )
 )
 
 (ChangeAttribValue blocks "DATE" str)
 (princ "\n ----------------------------------------------")
 (princ (strcat "\n --------- Adjust Date - Version " ADTVerNum " ---------"))
 (princ (strcat "\n ---------------- Date: " str " --------------"))
 (princ "\n ----------------------------------------------")
 (princ)
)
(defun ChangeAttribValue ( blocklist tag value / ss i e l )
 ;; Example By Lee Mac
 (setq tag       (strcase tag)
       value     (cons 1 value)
       blocklist (mapcar 'strcase blocklist)
       blocklist (apply 'strcat (cons (car blocklist) (mapcar '(lambda ( x ) (strcat "," x)) (cdr blocklist))))
 )
 (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blocklist) '(66 . 1))))
   (repeat (setq i (sslength ss))
     (setq e (ssname ss (setq i (1- i))))
     (while
       (eq "ATTRIB"
         (cdr (assoc 0 (setq l (entget (setq e (entnext e))))))
       )
       (if (eq tag (strcase (cdr (assoc 2 l))))
         (entupd
           (cdr
             (assoc -1
               (entmod (subst value (assoc 1 l) l))
             )
           )
         )
       )
     )
   )
 )
 (princ)
)