[LISP程序]：自动打印文件地址

xxb8601

在R14下打印图纸时不能自动加上文件地址，前些天发了个求助贴子，得到点提示，今天总算编好了这个程序，不过编得有点笨，贴出来，大家看看还有什么更间单的编法.其中BTL中定义了两个ADD1和ADD2的隐藏属性，文件地址就写在两属性插入点中间，编程中考虑了有人习惯把多张图放在一个文件的情况。文件录入后直接加在菜单中的PLOT前面加载运行就可以

2. 
   
3. (defun c:xx ()
   
4.   (setq temperr *error*)
   
5.   (setq *error* trap1)
   
6.   (setq ocm (getvar "CMDECHO"))
   
7.   (setq osm (getvar "osmode"))
   
8.   (setq ola (getvar "clayer"))
   
9.   (setvar "CMDECHO" 0)
   
10.   (setvar "osmode" 0)
    
11.   (command "layer" "s" "3" "")
    
12.   (command "zoom" "all" "")
    
13.   (setq filename (strcat (getvar "dwgprefix") (getvar "dwgname")))
    
14.   (setq ss (ssget "X" '((0 . "INSERT") (66 . 1) (2 . "BTL"))))
    
15.   (setq        num (sslength ss)
    
16.         n   (- num 1)
    
17.   )
    
18.   (repeat num
    
19.     (setq ent (ssname ss n))
    
20.     (setq ent (entnext ent))
    
21.     (while (/= (cdr (assoc 2 (entget ent))) "ADD1")
    
22.       (setq ent (entnext ent))
    
23.       (setq pt1 (cdr (assoc 10 (entget ent))))
    
24.       (setq a1 (car pt1))
    
25.       (setq b1 (+ (cadr pt1) 1))
    
26.       (setq pt3 (list a1 b1))
    
27.     )
    
28.     (while (/= (cdr (assoc 2 (entget ent))) "ADD2")
    
29.       (setq ent (entnext ent))
    
30.       (setq pt2 (cdr (assoc 10 (entget ent))))
    
31.       (setq a2 (car pt2))
    
32.       (setq b2 (+ (cadr pt2) 1))
    
33.       (setq pt4 (list a2 b2))
    
34.       (setq height (cdr (assoc 40 (entget ent))))
    
35.     )
    
36. 
    
37.     (command "erase" "CP" pt2 pt1 pt3 pt4 "" "" "" "")
    
38.     (command "text" "s" "hzl" "j" "F" pt1 pt2 height filename)
    
39.     (setq n (- n 1))
    
40.   )
    
41.   (command "zoom" "p" "")
    
42.   (setvar "osmode" osm)
    
43.   (setvar "cmdecho" ocm)
    
44.   (command "layer" "s" ola "")
    
45. )

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

micle

具体如何操作该程序?