[编程申请]：出图时打印文件地址

xxb8601

我发现CAD2002以后的版本在出图时可以在图纸上打印文件地址，而R14没这功能，因单位还是用R14，不想换版本，不知那位高手能帮忙用LISP编一个程序，在运行PLOT时能自动加上文件地址

aidraft

你可以在图框属性块里加一项“文件地址”，写一个程序，该程序用(GETVAR "DWGPREFIX") 和(GETVAR "DWGNAME")得到“文件地址”，然后UPDATE该属性。最后把这个宏命令加在菜单文件中PLOT项宏命令的前部，如^c^c^p(update_filename);plot;

xxb8601

总算编好了这个程序，不过编得有点笨，贴出来，大家看看还有什么更间单的编法,其中BTL中定义了两个ADD1和ADD2的隐藏属性，文件地址就写在两属性插入点中间，编程中考虑了有人习惯把多张图放在一个文件的情况

(defun c:xx()
   (setq temperr *error*)
   (setq *error* trap1)
   (setq ocm (getvar "CMDECHO"))
   (setq osm (getvar "osmode"))
   (setq ola (getvar "clayer"))
   (setvar "CMDECHO" 0)
   (setvar "osmode" 0)
   (command "layer" "s" "3" "")
   (command "zoom" "all" "")
(setq filename (strcat (getvar "dwgprefix") (getvar "dwgname")))
(setq ss (ssget "X" '((0 . "INSERT") (66 . 1) (2 . "BTL"))))
(setq num (sslength ss) n (- num 1))
  (repeat num
           (setq ent (ssname ss n))
           (setq ent (entnext ent))
     (while (/= (cdr (assoc 2 (entget ent))) "ADD1")
           (setq ent (entnext ent))       
           (setq pt1 (cdr (assoc 10 (entget ent))))
           (setq a1 (car pt1))
           (setq b1 (+ (cadr pt1) 1))
           (setq pt3 (list a1 b1))
      )
      (while (/= (cdr (assoc 2 (entget ent))) "ADD2")
           (setq ent (entnext ent))       
           (setq pt2 (cdr (assoc 10 (entget ent))))
           (setq a2 (car pt2))
           (setq b2 (+ (cadr pt2) 1))
           (setq pt4 (list a2 b2))
           (setq height (cdr (assoc 40 (entget ent))))       
       )   
           
           (command "erase" "CP" pt2 pt1 pt3 pt4 "" "" ""  "")
           (command "text" "s" "hzl" "j" "F" pt1 pt2 height  filename)           
       (setq n (- n 1))  
  )
(command "zoom""p" "")
(setvar "osmode" osm)
(setvar "cmdecho" ocm)
(command "layer" "s" ola "")
)