[编程交流] 需要帮助更新内的文本

(defun uinfo () (princ "\nUpdating Drawing Information...")
(if (= found 1)
 (progn (setq dummy (read-line infile))
        (setq desc (read dummy))
        (setq dummy (read-line infile))
        (setq drawing (read dummy)))
 (progn (setq desc    '(1 . "- NEW EQUIPMENT -"))
        (setq drawing '(1 . "- UNASSIGNED -"))))
(setq sset (ssget "X" (list (cons 0 "TEXT") (cons 8 "TITLE"))))
(setq lp 0)
 (while (< lp (sslength sset))
  (setq ent (entget (ssname sset lp))) (setq entinfo (cdr (assoc 1 ent)))
  (if (= (substr entinfo 1 4) "Desc") (entmod (subst desc (assoc 1 ent) ent)))
  (if (= (substr entinfo 1 4) "Draw") (entmod (subst drawing (assoc 1 ent) ent)))
  (if (= (substr entinfo 1 3) "Dwg") (entmod (subst drawing (assoc 1 ent) ent)))
  (if (= (substr entinfo 1 4) "DESC") (entmod (subst desc (assoc 1 ent) ent)))
  (if (= (substr entinfo 1 4) "DRAW") (entmod (subst drawing (assoc 1 ent) ent)))
  (if (= (substr entinfo 1 3) "DWG") (entmod (subst drawing (assoc 1 ent) ent)))
  (setq lp (1+ lp)))
(setq sset nil) (setq lp nil)
(setq sset (ssget "X" (list (cons 0 "TEXT") (cons 8 (strcat tcircuit "-EQMRK")))))
(setq lp 0)
(if (/= sset nil)
  (while (< lp (sslength sset))
   (setq ent (entget (ssname sset lp)))
   (setq entinfo (cdr (assoc 1 ent)))
   (if (= (substr entinfo 1 4) "Desc") (entmod (subst desc (assoc 1 ent) ent)))
   (if (= (substr entinfo 1 4) "Draw") (entmod (subst drawing (assoc 1 ent) ent)))
   (if (= (substr entinfo 1 3) "Dwg") (entmod (subst drawing (assoc 1 ent) ent)))
   (if (= (substr entinfo 1 4) "DESC") (entmod (subst desc (assoc 1 ent) ent)))
   (if (= (substr entinfo 1 4) "DRAW") (entmod (subst drawing (assoc 1 ent) ent)))
   (if (= (substr entinfo 1 3) "DWG") (entmod (subst drawing (assoc 1 ent) ent)))
   (setq lp (1+ lp))))
(princ "Done.")
(prin1))

(defun C:UPDATE ()
(setvar "CMDECHO" 0)
(setvar "MENUCTL" 0)
;; (command "._snap" "0.03125")
(command "plinewid" "0.0")
(if (null filename) (setq filename (getstring "\nPath and name of update file: ")))
(if (null tcircuit)
 (progn (C:EQUIP2))
 (progn (makenames tcircuit) (checklayers tcircuit)))
(if (null tcircuit)
 (progn
  (princ "\nCurrent name has not been established")
  (princ "\nplease type EQUIP and establish current equip. or make new"))
 (progn
  (openfile)
  (seek-tcircuit)
  (if (= (getvar "userr1") 0.0) (setvar "userr1" 3.0))
  (if (= (getvar "userr2") 0.0) (setvar "userr2" 1.0))
  (if (ssget "X" (list (cons 8 "CIRCUIT-INFO") (cons 0 "TEXT"))) (uinfo) (repeat 2 (read-line infile)))
  (if (ssget "X" (list (cons 8 "TITLE") (cons 0 "TEXT"))) (udates) (repeat 2 (read-line infile)))
;;   (uinfo)
;;   (udates)
  (if (= found 1)
;;    (progn (udp) (uext) (uldar) (uvalve))
   (princ "\nNO INFORMATION TO UPDATE"))
  (closefile)))
(command "._-layer" "s" PIPING "")
(princ))

; changes to issued for construction
: thanks to lee mac for original code
(vl-load-com)
; 1.  Get current date in mm/dd/yy format.
(defun ddmmyy (/ x today)
    (setvar "cmdecho" 0)
    (setq x (getvar "CDATE"))                 ; get current date
    (setq today ( rtos x 2 4))                    ; convert to a string
    (setq date (strcat (substr today 7 2) "."    (substr today 5 2) "." (substr today 3 2) ))
)
(setq oldtag1 "DRAWING_STATUS") ;attribute tag name
(setq newstr1 "ISSUED FOR CONSTRUCTION")
(setq oldtag2 "REV_NO")  ;attribute tag name
(setq newstr2 "0")
(setq ss1 (ssget "x"  '((0 . "INSERT") (2 . "DA1DRTXT"))))
(setq inc (sslength ss1))
(repeat inc      
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (setq inc (1- inc)) )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1) 
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2) 
) ; end if
) ; end for
) ;end repeat
(setq oldtag1 "REV-NO")
(setq newstr1 "0")
(ddmmyy)
(setq oldtag2 "DATE")
(setq newstr2 date)
(setq oldtag3 "AMENDMENT")
(setq newstr3 "ISSUED FOR CONSTRUCTION")
(setq ss2 (ssget "x"  '((0 . "INSERT") (2 . "REVTABLE"))))
(setq inc (sslength ss2))
(repeat inc
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq inc (1- inc)))) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1) 
)
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2) 
)
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr3) 
)
)
)
(setq ss1 nil)
; (setq ss2 nil)
(princ)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:setattributevalues ( blk lst / enx itm )
   (while (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       (if
           (and
               (setq itm (assoc (cdr (assoc 2 enx)) lst))
               (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
           )
           (entupd blk)
       )
   )
)

(setq  attriblst '("DRAWBY" "SURVEYBY" "DRAWDATE" "CLIENT" "FACILITY")
       valuelst '("TM" "JB" "2014/05/16" "OUR BEST CLIENT" "WAREHOUSE #2")
      updatelst (mapcar '(lambda (a b) (cons a b)) attriblst valuelst)
)
( LM:setattributevalues "TitleBlock Name" updatelst)