Lisp以同步属性
先生们,我正在寻找一个lisp来同步属性。例如,块Alpha有一个名为“LOCID”的属性,其周围有块Beta、Charlie和Delta。所有四个块都有不同的名称、属性和参数,但它们都有共同的“LOCID”。Alpha已经有“LOCID”的值,但其他值没有。我希望lisp通过选择所有四个块,将所有四个块的“LOCID”同步到Alpha的值。此外,这四个可能并不总是同时存在,但Alpha总是存在。有多组Alpha&friends。
有人有Lisp程序可以做到这一点吗?这远远超过我的经验水平。 你好
像这样的?(刚刚拼凑起来):
(defun c:SyncAtt ( / *error* _StartUndo _EndUndo doc source tag val ss )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(if doc (_EndUndo doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if
(and
(setq source
(LM:Selectif
(lambda ( x )
(eq "ATTRIB" (cdr (assoc 0 (entget x))))
)
nentsel "\nSelect Source Attribute: "
)
)
(ssget '((0 . "INSERT") (66 . 1)))
)
(progn
(setq tag (cdr (assoc 2 (entget source)))
val (cdr (assoc 1 (entget source)))
)
(_StartUndo doc)
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
(mapcar
(function
(lambda ( attrib )
(if (eq tag (vla-get-TagString attrib))
(vla-put-TextString attrib val)
)
)
)
(vlax-invoke obj 'GetAttributes)
)
)
(vla-delete ss)
(_EndUndo doc)
)
)
(princ)
)
;;---------------------=={ Select if }==----------------------;;
;; ;;
;;Continuous selection prompts until the predicate function ;;
;;foo is validated ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 - www.lee-mac.com ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee @ lee-mac.com ;;
;;Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;foo - optional predicate function taking ename argument ;;
;;fun - selection function to invoke ;;
;;str - prompt string ;;
;;------------------------------------------------------------;;
;;Returns:selected entity ename if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:Selectif ( foo fun str / e )
;; © Lee Mac 2010
(while
(progn (setq e (car (fun str)))
(cond
( (eq 'ENAME (type e))
(if (and foo (not (foo e)))
(princ "\n** Invalid Object Selected **")
)
)
)
)
)
e
)
您可能也对此感兴趣-如果您将其与“TextString”属性一起使用,它也可以执行您的任务。 你=太棒了。非常感谢。你刚刚帮我省了几个小时的工作。如果你在SoCal,我欠你一两品脱。
谢谢,伙计,很高兴我能帮上忙 李·麦克,
如果我想暂时将块的颜色从“Bylayer”更改为另一种颜色(如黄色),我需要添加什么。这样我就知道哪些对象已经完成,哪些还没有完成?
我试着利用afralisp的这个功能,但由于我认为它不可用,所以无法使其工作。
(setq check (vlax-property-available-p ss "Color" T))
(if check
(vlax-put-property ss 'Color 4)
);
我在过去使用过类似的东西,但我还没有弄清楚如何将ActiveSelection转换为一组珐琅或单个VLA对象
(setq RX (vlax-vla-object->ename oBkRef))
(command "chprop" RX "" "color" "2" "")
您好,约翰,我将使用(重画珐琅3)高亮显示实体,然后命令regen恢复正常 今天早上有点轻,这是我想到的。。。
(命令“chprop”p“”color“3”)
我更改了这部分。。。
(if (eq tag (vla-get-TagString attrib))
(progn
(vla-put-TextString attrib val)
(command "chprop" "p" "" "color" "3" "")
)
)
到这一部分。。。
(if (eq tag (vla-get-TagString attrib))
(vla-put-TextString attrib val)
)
页:
[1]