(defun c:test ( / *error* dim fun lst rgx str tag )
(setq tag "dimensions") ;; Tag to update
(defun *error* ( msg )
(if (= 'vla-object (type rgx)) (vlax-release-object rgx))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun sel ( msg prd / ent ) (setq prd (eval prd))
(while
(progn (setvar 'errno 0) (setq ent (car (entsel msg)))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent) nil)
( (null (prd ent)))
)
)
)
ent
)
(setq fun '(lambda ( x ) (or (wcmatch (cdr (assoc 0 (entget x))) "*DIMENSION") (prompt "\nInvalid object selected.")))
dim(sel "\nSelect first dimension: " fun)
)
(cond
( (not dim))
( (or (null (setq rgx (vl-catch-all-apply 'vlax-get-or-create-object '("vbscript.regexp"))))
(vl-catch-all-error-p rgx)
)
(princ "\nUnable to interface with RegEx Object.")
)
( t
(setq lst (cons (LM:getdimstring dim) lst))
(while (setq dim (sel "\nSelect next dimension <done>: " fun))
(setq lst (cons (LM:getdimstring dim) lst))
)
(setq str
(apply 'strcat
(cdr
(apply 'append
(mapcar '(lambda ( x ) (list "*" (LM:quickunformat rgx x)))
(reverse lst)
)
)
)
)
)
(sel "\nSelect block: "
'(lambda ( e / x )
(cond
( (not
(and
(setq x (entget e))
(= "INSERT" (cdr (assoc 0 x)))
(= 1 (cdr (assoc 66 x)))
)
)
(prompt "\nSelected object is not an attributed block.")
)
( (LM:setattributevalue e tag str))
( (prompt (strcat "\nSelected block does not contain the tag \"" tag "\".")))
)
)
)
)
)
(*error* nil)
(princ)
)
;; Get Dimension String-Lee Mac
;; Returns the displayed content of a dimension
(defun LM:getdimstring ( ent / enx rtn )
(if
(and
(setq enx (entget ent))
(wcmatch (cdr (assoc 0 enx)) "*DIMENSION")
(setq ent (tblobjname "block" (cdr (assoc 2 enx))))
(setq ent (entnext ent)
enx (entgetent)
)
)
(while (and ent (null rtn))
(if (= "MTEXT" (cdr (assoc 0 enx)))
(setq rtn(cdr (assoc 1 enx)))
)
(setq ent (entnext ent)
enx (entgetent)
)
)
)
rtn
)
;; Quick Unformat-Lee Mac
;; Returns a string with all MText formatting codes removed.
;; rgx - Regular Expressions (RegExp) Object
;; str - String to process
(defun LM:quickunformat ( rgx str )
(if
(null
(vl-catch-all-error-p
(setq str
(vl-catch-all-apply
'(lambda nil
(foreach pair
'(
("\032" . "\\\\\\\\")
(" " . "\\\\P|\\n|\\t")
("$1" . "\\\\(\\\\)|\\\\[^\\\\;]*;|\\\\")
("$1$2/$3". "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
("\\$1$2$3" . "(\\\\)|({)|(})")
("\\\\" . "\032")
)
(vlax-put-property rgx 'pattern (cdr pair))
(setq str (vlax-invoke rgx 'replace str (car pair)))
)
)
)
)
)
)
str
)
)
;; Set Attribute Value-Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - Block (Insert) Entity Name
;; tag - Attribute TagString
;; val - Attribute Value
;; Returns: Attribute value if successful, else nil.
(defun LM:setattributevalue ( blk tag val / enx )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
(if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
(if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
(progn
(entupd blk)
val
)
)
(LM:setattributevalue blk tag val)
)
)
)
(vl-load-com) (princ) Lee和往常一样棒，但我认为你错过了一件事，OP希望能够选择一个dim或输入一个手动值，你的代码要求选择一个dim，并给出信息，这不是dim，而不是我倾向于选择dim的概念，或者说按enter键输入一个值。我没有在之前的帖子中明确地问到你如何在没有额外步骤的情况下选择dim或value，我认为这是不可能的
尺寸值尺寸=123.45*弗雷德*456.78
谢谢你，塔瓦先生。
也许我的解释不清楚。
以下李代码是正确的。但仍然是一个缺陷。
无法手动输入值。只能通过“维度”获取。
谢谢你，李，非常好。
有可能这样做吗？
选择第一个维度：
选择下一个维度：
选择下一个维度： 不幸的是，实际工作遇到了阻碍，这段代码有一个问题，我们会尽快找到时间解决，但方法是存在的。
(vl-load-com)
(defun pullapart ()
(setq val (rtos (vla-get-Measurement (vlax-ename->vla-object(car obj)))2 2))
)
(defun pickobj ()
(setq obj (entsel "\nPick a dim - Enter for value - Double Enter to exit"))
(if (= obj nil)
(setq Val (getstring "\nEnter Value"))
(pullapart) ; a defun that checks for a "DIM" and returns val=measurement
) ; if
) ; defun
(setq y 1)
(setq ss1 (car (entsel "\nSelect block")))
(setq bname (vla-get-name(vlax-ename->vla-object SS1)))
(setq x (getint "\nEnter attribute position within block as a Number "))
(pickobj) ; need at least one value
(setq newstrblank val) ; dummy value
(while (=/ val nil)
(SETQ newstrblank (strcat newstrblank "*" val)) ;
(pickobj)
)
(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes)
(if (= y x)
(progn
(setq newstr (vla-get-textstring att ))
(vla-put-textstring att newstrblank)
)
)
(setq y (+ Y 1))
)
(princ)
谢谢大家
以下是一种可能的解决方案，允许在同一提示下进行对象选择和任意输入：
(defun c:test ( / *error* dim lst rgx str tag )
(setq tag "dimensions") ;; Tag to update
(defun *error* ( msg )
(if (= 'vla-object (type rgx)) (vlax-release-object rgx))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun sel ( msg prd / ent ) (setq prd (eval prd))
(while
(progn (setvar 'errno 0) (setq ent (car (entsel msg)))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent) nil)
( (null (prd ent)))
)
)
)
ent
)
(cond
( (= "" (setq dim (LM:select-or-text "\nSelect first dimension or enter value: " '((0 . "*DIMENSION"))))))
( (or (null (setq rgx (vl-catch-all-apply 'vlax-get-or-create-object '("vbscript.regexp"))))
(vl-catch-all-error-p rgx)
)
(princ "\nUnable to interface with RegEx Object.")
)
( t
(setq lst (cons (if (= 'str (type dim)) dim (LM:getdimstring dim)) lst))
(while (/= "" (setq dim (LM:select-or-text "\nSelect next dimension or enter value <done>: " '((0 . "*DIMENSION")))))
(setq lst (cons (if (= 'str (type dim)) dim (LM:getdimstring dim)) lst))
)
(setq str
(apply 'strcat
(cdr
(apply 'append
(mapcar '(lambda ( x ) (list "*" (LM:quickunformat rgx x)))
(reverse lst)
)
)
)
)
)
(sel "\nSelect block: "
'(lambda ( e / x )
(cond
( (not
(and
(setq x (entget e))
(= "INSERT" (cdr (assoc 0 x)))
(= 1 (cdr (assoc 66 x)))
)
)
(prompt "\nSelected object is not an attributed block.")
)
( (LM:setattributevalue e tag str))
( (prompt (strcat "\nSelected block does not contain the tag \"" tag "\".")))
)
)
)
)
)
(*error* nil)
(princ)
)
;; Get Dimension String-Lee Mac
;; Returns the displayed content of a dimension
(defun LM:getdimstring ( ent / enx rtn )
(if
(and
(setq enx (entget ent))
(wcmatch (cdr (assoc 0 enx)) "*DIMENSION")
(setq ent (tblobjname "block" (cdr (assoc 2 enx))))
(setq ent (entnext ent)
enx (entgetent)
)
)
(while (and ent (null rtn))
(if (= "MTEXT" (cdr (assoc 0 enx)))
(setq rtn(cdr (assoc 1 enx)))
)
(setq ent (entnext ent)
enx (entgetent)
)
)
)
rtn
)
;; Quick Unformat-Lee Mac
;; Returns a string with all MText formatting codes removed.
;; rgx - Regular Expressions (RegExp) Object
;; str - String to process
(defun LM:quickunformat ( rgx str )
(if
(null
(vl-catch-all-error-p
(setq str
(vl-catch-all-apply
'(lambda nil
(foreach pair
'(
("\032" . "\\\\\\\\")
(" " . "\\\\P|\\n|\\t")
("$1" . "\\\\(\\\\)|\\\\[^\\\\;]*;|\\\\")
("$1$2/$3". "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
("\\$1$2$3" . "(\\\\)|({)|(})")
("\\\\" . "\032")
)
(vlax-put-property rgx 'pattern (cdr pair))
(setq str (vlax-invoke rgx 'replace str (car pair)))
)
)
)
)
)
)
str
)
)
;; Set Attribute Value-Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - Block (Insert) Entity Name
;; tag - Attribute TagString
;; val - Attribute Value
;; Returns: Attribute value if successful, else nil.
(defun LM:setattributevalue ( blk tag val / enx )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
(if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
(if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
(progn
(entupd blk)
val
)
)
(LM:setattributevalue blk tag val)
)
)
)
;; Selection or Text-Lee Mac
;; Prompts the user to select an object or enter an arbitrary string.
;; msg - Prompt string
;; ftr - ssget filter list
;; Returns: Entity name of selected entity or entered string; "" if enter is pressed.
(defun LM:select-or-text ( msg ftr / gr1 gr2 rtn sel )
(setq msg (princ (cond (msg) ("\nSelect object: ")))
rtn ""
)
(while
(progn
(setq gr1 (grread nil 14 2)
gr2 (cadr gr1)
gr1 (cargr1)
)
(cond
( (= 3 gr1)
(if (ssget gr2) ;; nentselp is slow for xrefs
(if (setq sel (ssget gr2 ftr))
(progn (setq rtn (ssname sel 0)) nil)
(princ (strcat "\nInvalid object selected." msg))
)
(princ (strcat "\nMissed, try again." msg))
)
)
( (= 2 gr1)
(cond
( (< 31 gr2 127)
(setq rtn (strcat rtn (princ (chr gr2))))
)
( (= 13 gr2)
nil
)
( (and (= 8 gr2) (< 0 (strlen rtn)))
(setq rtn (substr rtn 1 (1- (strlen rtn))))
(princ "\010 \010")
)
( t )
)
)
( (= 25 gr1)
nil
)
( t )
)
)
)
rtn
)
(vl-load-com) (princ)
难以置信的李，非常非常好。非常感谢你。
欢迎你，卡德凡-写作是一个有趣的挑战。
我现在意识到，我将属性标记保留为“tag1”，这是我用于测试的内容-我现在在上述代码中对此进行了修改。
李 Lee很好的代码与往常一样，我之所以表示使用属性创建顺序，是因为它使函数与任何属性块一起工作，您不需要硬编码的属性名称。因此，对于不同的块，如果有不同的标记名，则必须复制所有代码。在我写的第一篇小文章中，我在一个有12个属性的块上进行了测试，并通过重复代码更改了多个属性。正如您和其他阅读本文的人所知，可能99%的属性请求都是硬编码到标记名的，但可能更具全局性。
页:
1
[2]