[LISP程序]：图形文件更新登记工具-图形版本号修改及注释登记。

lsjjm

图形文件更新登记工具-图形版本号修改及注释登记。

此程序可以对话框操作完成如下功能：
自动修改图纸右下角和右上角的两处版本号(rev)；
在图纸标题栏右上角自动添加一表格和修改号，版本号，简单注释，修改人和修改日期， 并与原来带属性的标题栏块组成一体。可连续再次修改。
此程序适用英制单位，其中版本号属性标志为T2,T25。 相信有些
LISP基础的朋友稍加改动，便可适合你自己的使用环境！

By Richard Liang
Paker Hannifin (NZ) Ltd.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:updateecn ()                       
  (vl-load-com)
;  (load "lsplib")
  (setq index (load_dialog (findfile "dial.dcl")))   
  (if (not (new_dialog "dupe" index))(exit))
; (imagep)
  (set_tile "da" (today))
  (action_tile "accept"
    "(setq en (get_tile \"en\")
          dis (get_tile \"de\")
           da (get_tile \"da\")
           by (get_tile \"by\"))
     (done_dialog)")
  (action_tile "cancel" "(exit)")
  (start_dialog)
  (unload_dialog index)
  (setvar "attreq" 1)
  (setq ss (ssget "X" '((0 . "INSERT")(66 . 1))))
  (setq blk (ssname ss 0))
  (setq ln (length (getattributes blk)))
  (setq m (last (assoc (strcat "T" (itoa (- ln 3)))(getattributes blk)))
     attobj (vlax-ename->vla-object m)
          v (vla-get-textstring attobj))
  (if (= v "-")(setq nrev "A")(setq nrev (chr (1+ (ascii v)))))
  (setq ipt (vlax-safearray->list
                (vlax-variant-value
                (vla-get-textalignmentpoint attobj))))
  (setq ipt (list (- (car ipt) 0.4725)(+ (cadr ipt) 0.0787)))
  (setvar "osmode" 0)
  (setvar "cecolor" "4")
  (setq ee0 (ssget "x"))
  (vl-cmdf "line" ipt "@0,0.1575" "@3.23,0" "@0,-0.1575" "")
  (vl-cmdf "line" "@-0.308,0" "@0,0.1575" "")
  (vl-cmdf "line" "@-0.787,0" "@0,-0.1575" "" "line" "@-1.5049,0" "@0,0.1575" "")
  (vl-cmdf "line" "@-0.315,0" "@0,-0.1575" "")
  (setq ee2 (ssget "x"))
  (vl-cmdf "select" ee2 "r" ee0 "")
  (setq ee (ssget "p"))
  (addobjstoblock blk ee)
  (setvar "cecolor" "6")
  (addatttoblock blk 0.06 "" (mapcar '+ ipt (list 0.1575 0.07875))
    (strcat "T" (itoa (+ ln 1))) (strcat "#" en))
  (setq blk (entlast))
  (addatttoblock blk 0.06 "" (mapcar '+ ipt (list 0.4726 0.07875))
    (strcat "T" (itoa (+ ln 2))) nrev)
  (setq blk (entlast))
  (addatttoblock blk 0.06 "" (mapcar '+ ipt (list 1.3826 0.07875))
    (strcat "T" (itoa (+ ln 3))) dis)
  (setq blk (entlast))
  (addatttoblock blk 0.06 "" (mapcar '+ ipt (list 2.5285 0.07875))
    (strcat "T" (itoa (+ ln 4))) da)
  (setq blk (entlast))
  (addatttoblock blk 0.06 "" (mapcar '+ ipt (list 3.076 0.07875))
    (strcat "T" (itoa (+ ln 5))) by)
  (setq blk (entlast))
  (foreach i (list "T2" "T25")
    (setq m (last (assoc i (getattributes blk)))
     attobj (vlax-ename->vla-object m))
    (vla-put-textstring attobj (chr (1+ (ascii v))))
  )
  (princ)
)
；
(defun addobjstoblock (blk eset / doc blkref blkdef inspt refpt)        
  (setq        doc        (vla-get-ActiveDocument (vlax-get-acad-object))
        blkref        (vlax-ename->vla-object blk)
        blkdef        (vla-Item (vla-get-Blocks doc)(vla-get-Name blkref))
        inspt        (vlax-variant-value (vla-get-InsertionPoint blkref))
        ssarray        (selectionset->array eset)
        refpt        (vlax-3d-point '(0 0 0))
  )
  (foreach ent (vlax-safearray->list ssarray)(vla-Move ent inspt refpt))
  (vla-CopyObjects doc ssarray blkdef)
  (foreach ent (vlax-safearray->list ssarray)(vla-delete ent))
)
；
(defun addatttoblock (blk h prom ptatt tag v)      
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        obj (vlax-ename->vla-object blk)
      ptblk (vlax-safearray->list
            (vlax-variant-value (vla-get-insertionpoint obj)))
     blkdef (vla-item (vla-get-blocks doc)(vla-get-name obj)))
  (setq ptatt (vlax-3d-point (mapcar '- ptatt ptblk))
       attdef (vla-addattribute blkdef h acAttributeModeverify prom ptatt tag v))
  (vla-put-alignment attdef 10)
  (vla-put-textalignmentpoint attdef ptatt)
  (if (= (getvar "tilemode") 1)
    (setq space (vla-get-modelspace doc))
    (setq space (vla-get-paperspace doc))
  )
  (setq blkref (vla-insertblock
                 space
                 (vlax-3d-point ptblk)
                 (vla-get-name blkdef)
                 (vla-get-xscalefactor obj)
                 (vla-get-yscalefactor obj)
                 (vla-get-zscalefactor obj)
                 (vla-get-rotation obj)
               )
  )
  (vla-delete obj)
  (vlax-release-object obj)
)

对话框文件：
dupe : dialog {label = "Update ECN";key="up";
  : edit_box {label="ECN #:"; key = "en"; edit_width = 3;}
  : edit_box {label="Description:"; key = "de"; edit_width = 24;}
  : row {
    : edit_box {label="Date:"; key = "da";edit_width = 8;} spacer; spacer;spacer;
    : edit_box {label="By:"; key = "by";  value="R.L."; edit_width = 3;}
  }
  spacer;spacer;
  ok_cancel;
  : row {
    : image { key = "im" ; width = 4; fixed_width= true;}
    : paragraph {
      : text_part { label = "Designed and Created"; alignment=right;}
      : text_part { label = "by Richard Liang"; alignment=right;}
    }
  }
}