块字段Lisp例程
嘿伙计们，我想知道是否有人可以帮我解决Lisp程序的问题。我对编写LISP基本上是新手。我使用许多字段命令将细节剪切引用到相应的细节标题栏。这样，如果我重新编号实际的细节或移动图纸，则快速重新生成，并相应地更新平面细节切割。剪辑和标题都是动态块。我确实有一些类似的开始代码，由LeeMac编写，但只复制field command属性，并将其应用于另一个属性，文本或任何内容。它无法复制实际的“text”属性并将其转换为field命令。随附的图片显示了我在说什么。我想为细节的引用6创建一个字段“文本链接”LISP例程。这样我就不必手动将它们全部链接起来。如果你们能帮我的话，这会节省我很多时间。下面的脚本。
;;--------------------------=={ Copy Field }==--------------------------;;
;; ;;
;;This program enables the user to copy a field expression from a ;;
;;selected source object to multiple destination objects in a ;;
;;drawing. ;;
;; ;;
;;Upon issuing the command syntax 'copyfield' at the AutoCAD ;;
;;command-line, the user is prompted to select an annotation object ;;
;;(Text, MText, Attribute, Multileader, Dimension) containing a ;;
;;field expression to be copied. ;;
;; ;;
;;Following a valid response, the user may then copy the field to ;;
;;multiple selected destination objects in the drawing. ;;
;;----------------------------------------------------------------------;;
;;Author:Lee Mac, Copyright © 2013-www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;;Version 1.0 - 2013-07-14 ;;
;; ;;
;;- First release. ;;
;;----------------------------------------------------------------------;;
;;Version 1.1 - 2017-06-13 ;;
;; ;;
;;- Updated LM:fieldcode function to account for field expressions ;;
;; greater than 250 characters in length. ;;
;;----------------------------------------------------------------------;;
(defun c:copyfield ( / *error* select src )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun select ( msg fun / ent rtn )
(while
(progn (setvar 'errno 0) (setq ent (nentsel msg))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'list (type ent))
(cond
( (progn
(if (= 4 (length ent))
(setq ent (last (last ent)))
(setq ent (car ent))
)
(not (wcmatch (cdr (assoc 0 (entget ent))) "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION"))
)
(princ "\nInvalid object selected.")
)
( (not (setq rtn ((eval fun) ent))))
)
)
)
)
)
rtn
)
(if
(setq src
(select "\nSelect source field: "
(function
(lambda ( ent )
(cond ((LM:fieldcode ent)) ((not (princ "\nSelected object does not contain a field."))))
)
)
)
)
(progn
(LM:startundo (LM:acdoc))
(select "\nSelect destination object <Exit>: "
(function
(lambda ( ent / obj )
(cond
( (null (vlax-write-enabled-p (setq obj (vlax-ename->vla-object ent))))
(princ "\nSelected object is on a locked layer.")
)
( (vlax-property-available-p obj 'textoverride t)
(vla-put-textoverride obj src)
(command "_.updatefield" ent "")
)
( (vlax-property-available-p obj 'textstring t)
(vla-put-textstring obj src)
(command "_.updatefield" ent "")
)
)
nil
)
)
)
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; Field Code-Lee Mac
;; Returns the field expression associated with an entity
(defun LM:fieldcode ( ent / replacefield replaceobject fieldstring enx )
(defun replacefield ( str enx / ent fld pos )
(if (setq pos (vl-string-search "\\_FldIdx" (setq str (replaceobject str enx))))
(progn
(setq ent (assoc 360 enx)
fld (entget (cdr ent))
)
(strcat
(substr str 1 pos)
(replacefield (fieldstring fld) fld)
(replacefield (substr str (1+ (vl-string-search ">%" str pos))) (cdr (member ent enx)))
)
)
str
)
)
(defun replaceobject ( str enx / ent pos )
(if (setq pos (vl-string-search "ObjIdx" str))
(strcat
(substr str 1 (+ pos 5)) " "
(LM:ObjectID (vlax-ename->vla-object (cdr (setq ent (assoc 331 enx)))))
(replaceobject (substr str (1+ (vl-string-search ">%" str pos))) (cdr (member ent enx)))
)
str
)
)
(defun fieldstring ( enx / itm )
(if (setq itm (assoc 3 enx))
(strcat (cdr itm) (fieldstring (cdr (member itm enx))))
(cond ((cdr (assoc 2 enx))) (""))
)
)
(if (and (wcmatch(cdr (assoc 0 (setq enx (entget ent)))) "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION")
(setq enx (cdr (assoc 360 enx)))
(setq enx (dictsearch enx "ACAD_FIELD"))
(setq enx (dictsearch (cdr (assoc -1 enx)) "TEXT"))
)
(replacefield (fieldstring enx) enx)
)
)
;; ObjectID-Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:ObjectID ( obj )
(eval
(list 'defun 'LM:ObjectID '( obj )
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:ObjectID obj)
)
;; Start Undo-Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo-Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document-Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: CopyField.lsp | Version 1.1 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"copyfield\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
页:
[1]