[下载]：抛砖引玉~还是双向偏移的程序.

carrot1983

我不知道这个论坛里有没有谁有双向偏移的lisp能不能给我参考一下。要在R14下能用的。(顺便问一下vl-***的lisp命令可以在r14下用吗？有点菜~~)，下面是我自己编的，很烦。局限line和xline可以用。谁有矩形和圆等都可以实现的？？？

2. 
   
3.   [FONT=courier new]
   
4. ;**********************************************双向偏移ss_利用偏移
   
5. ;可用来双向偏移line和pline
   
6. 
   
7. (defun c:ss()
   
8.    (setq orig_cmd (getvar "cmdecho"))
   
9.    (setvar "cmdecho" 0)                ; cmdecho = 0
   
10.    
    
11.    (if (= nil dis_orig) (setq dis_orig 100))
    
12.    (initget 6 "e n")
    
13.    (setq DIS (getdist (strcat "选择偏移距离或[删除原来的线(E)/偏移后的图层(N)]<" (rtos dis_orig) ">:")))
    
14. (cond
    
15.    ((= "e" DIS) (setq k 22))
    
16.    ((= "n" DIS) (setq k 33))
    
17.    ((= nil DIS) (setq DIS dis_orig k 11))
    
18.    ((and (/= nil DIS) (/= "e" DIS)(/= "n" DIS)) (setq dis_orig DIS k 11))
    
19. )
    
20. ;************************************输入是数值时。
    
21.   (while (= k 11)
    
22. 
    
23.       (setq en (entsel "\n>>选择要偏移的线:")) ;选择单个图元
    
24.   ;以下表示，如果选择为空集则退出lisp返回AutoCAD系统。
    
25.    (if (= nil en)
    
26.     (progn
    
27.       (princ "\n>>")
    
28.       (exit)
    
29.   ));  end of if
    
30.       (setq na (car en)) ;取得选到的图元的图元名。
    
31. 
    
32.       (setq data (entget na))
    
33.       (setq pt (cdr (assoc '10 data)))  ;取得图元（线）的第一点。
    
34.       (setq pt_x (car pt))
    
35.       (setq pt_y (cadr pt))
    
36.       (setq pt_x+ (* 2 pt_x))
    
37.       (setq pt_x- (* -2 pt_x))
    
38.       (setq pt_y+ (* 2 pt_y))
    
39.       (setq pt_y- (* -2 pt_y))
    
40.       (setq pt_oo+ (list pt_x+ pt_y+))
    
41.       (setq pt_oo- (list pt_x- pt_y-))
    
42.       (command "OFFSET" dis_orig na pt_oo+ "")
    
43.       (command "OFFSET" dis_orig na pt_oo- "")   
    
44.    
    
45.   );end of while
    
46. 
    
47. ;************************************输入"e"
    
48. (while (= k 22)
    
49.    (setq DIS dis_orig)
    
50.    (setq en (entsel "\n>>选择要偏移的线:")) ;选择单个图元
    
51.   ;以下表示，如果选择为空集则退出lisp返回AutoCAD系统。
    
52.    (if (= nil en)
    
53.     (progn
    
54.      
    
55.       (princ "\n>>")
    
56.       (exit)
    
57.   ));  end of if
    
58.       (setq na (car en)) ;取得选到的图元的图元名。
    
59. 
    
60.       (setq data (entget na))
    
61.       (setq pt (cdr (assoc '10 data)))  ;取得图元（线）的第一点。
    
62.       (setq pt_x (car pt))
    
63.       (setq pt_y (cadr pt))
    
64.       (setq pt_x+ (* 2 pt_x))
    
65.       (setq pt_x- (* -2 pt_x))
    
66.       (setq pt_y+ (* 2 pt_y))
    
67.       (setq pt_y- (* -2 pt_y))
    
68.       (setq pt_oo+ (list pt_x+ pt_y+))
    
69.       (setq pt_oo- (list pt_x- pt_y-))
    
70.       (command "OFFSET" dis_orig na pt_oo+ "")
    
71.       (command "OFFSET" dis_orig na pt_oo- "")
    
72.       (command "ERASE" na"")
    
73.   )  
    
74.   
    
75.   ;************************************输入"n"
    
76.   
    
77.    (while (= k 33)
    
78.       (setq DIS dis_orig)
    
79.       (setq TC (getstring "\n偏移后线的图层: "))
    
80. 
    
81.       (setq en (entsel "\n>>选择要偏移的线:")) ;选择单个图元
    
82.   ;以下表示，如果选择为空集则退出lisp返回AutoCAD系统。
    
83.    (if (= nil en)
    
84.     (progn
    
85.       (princ "\n>>")
    
86.       (exit)
    
87.   ));  end of if
    
88.       (setq na (car en)) ;取得选到的图元的图元名。
    
89.       (setq data (entget na))
    
90.       (setq pt (cdr (assoc '10 data)))  ;取得图元（线）的第一点。
    
91.       (setq pt_x (car pt))
    
92.       (setq pt_y (cadr pt))
    
93.       (setq pt_x+ (* 2 pt_x))
    
94.       (setq pt_x- (* -2 pt_x))
    
95.       (setq pt_y+ (* 2 pt_y))
    
96.       (setq pt_y- (* -2 pt_y))
    
97.       (setq pt_oo+ (list pt_x+ pt_y+))
    
98.       (setq pt_oo- (list pt_x- pt_y-))
    
99.       (setq ss_oo (ssadd))
    
100.       (command "OFFSET" dis_orig na pt_oo+ "")
     
101.       (ssadd (entlast) ss_oo)
     
102.       (command "OFFSET" dis_orig na pt_oo- "")
     
103.       (ssadd (entlast) ss_oo)
     
104. 
     
105.              (setq  slen (- (sslength ss_oo) 1))
     
106.              (setq  i 0)
     
107.         (while  (<= i slen)
     
108.              (setq _oo_n (ssname ss_oo i))
     
109.              (setq _oo_data (entget _oo_n))
     
110.              (setq _oo_tc (cdr (assoc '8 _oo_data)))
     
111.              (setq _oo_data (subst (cons 8 TC) (assoc '8 _oo_data) _oo_data))
     
112.              (entmod _oo_data)
     
113.              (setq i (+ i 1))
     
114.         )
     
115. 
     
116.       
     
117.    ) ;end of while
     
118.    
     
119.   
     
120.   (prin1)
     
121.   )
     
122.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;**********************************************双向偏移ss_利用偏移<br /> ;可用来双向偏移line和pline<br /> <br /> (defun c:ss()<br />    (setq orig_cmd (getvar "cmdecho"))<br />    (setvar "cmdecho" 0)                ; cmdecho = 0<br />    <br />    (if (= nil dis_orig) (setq dis_orig 100))<br />    (initget 6 "e n") <br />    (setq DIS (getdist (strcat "选择偏移距离或[删除原来的线(E)/偏移后的图层(N)]<" (rtos dis_orig) ">:")))<br /> (cond<br />    ((= "e" DIS) (setq k 22))<br />    ((= "n" DIS) (setq k 33))<br />    ((= nil DIS) (setq DIS dis_orig k 11))<br />    ((and (/= nil DIS) (/= "e" DIS)(/= "n" DIS)) (setq dis_orig DIS k 11))<br /> )<br /> ;************************************输入是数值时。<br />   (while (= k 11)<br /> <br />       (setq en (entsel "\n>>选择要偏移的线:")) ;选择单个图元<br />   ;以下表示，如果选择为空集则退出lisp返回AutoCAD系统。<br />    (if (= nil en)<br />     (progn<br />       (princ "\n>>")<br />       (exit)<br />   ));  end of if<br />       (setq na (car en)) ;取得选到的图元的图元名。<br /> <br />       (setq data (entget na))<br />       (setq pt (cdr (assoc '10 data)))  ;取得图元（线）的第一点。<br />       (setq pt_x (car pt)) <br />       (setq pt_y (cadr pt))<br />       (setq pt_x+ (* 2 pt_x))<br />       (setq pt_x- (* -2 pt_x))<br />       (setq pt_y+ (* 2 pt_y))<br />       (setq pt_y- (* -2 pt_y))<br />       (setq pt_oo+ (list pt_x+ pt_y+))<br />       (setq pt_oo- (list pt_x- pt_y-))<br />       (command "OFFSET" dis_orig na pt_oo+ "")<br />       (command "OFFSET" dis_orig na pt_oo- "")    <br />     <br />   );end of while<br /> <br /> ;************************************输入"e"<br /> (while (= k 22)<br />    (setq DIS dis_orig)<br />    (setq en (entsel "\n>>选择要偏移的线:")) ;选择单个图元<br />   ;以下表示，如果选择为空集则退出lisp返回AutoCAD系统。<br />    (if (= nil en)<br />     (progn<br />      <br />       (princ "\n>>")<br />       (exit)<br />   ));  end of if<br />       (setq na (car en)) ;取得选到的图元的图元名。<br /> <br />       (setq data (entget na))<br />       (setq pt (cdr (assoc '10 data)))  ;取得图元（线）的第一点。<br />       (setq pt_x (car pt)) <br />       (setq pt_y (cadr pt))<br />       (setq pt_x+ (* 2 pt_x))<br />       (setq pt_x- (* -2 pt_x))<br />       (setq pt_y+ (* 2 pt_y))<br />       (setq pt_y- (* -2 pt_y))<br />       (setq pt_oo+ (list pt_x+ pt_y+))<br />       (setq pt_oo- (list pt_x- pt_y-))<br />       (command "OFFSET" dis_orig na pt_oo+ "")<br />       (command "OFFSET" dis_orig na pt_oo- "")<br />       (command "ERASE" na"")<br />   )  <br />   <br />   ;************************************输入"n" <br />   <br />    (while (= k 33)<br />       (setq DIS dis_orig)<br />       (setq TC (getstring "\n偏移后线的图层: "))<br /> <br />       (setq en (entsel "\n>>选择要偏移的线:")) ;选择单个图元<br />   ;以下表示，如果选择为空集则退出lisp返回AutoCAD系统。<br />    (if (= nil en)<br />     (progn<br />       (princ "\n>>")<br />       (exit)<br />   ));  end of if<br />       (setq na (car en)) ;取得选到的图元的图元名。<br />       (setq data (entget na))<br />       (setq pt (cdr (assoc '10 data)))  ;取得图元（线）的第一点。<br />       (setq pt_x (car pt)) <br />       (setq pt_y (cadr pt))<br />       (setq pt_x+ (* 2 pt_x))<br />       (setq pt_x- (* -2 pt_x))<br />       (setq pt_y+ (* 2 pt_y))<br />       (setq pt_y- (* -2 pt_y))<br />       (setq pt_oo+ (list pt_x+ pt_y+))<br />       (setq pt_oo- (list pt_x- pt_y-))<br />       (setq ss_oo (ssadd))<br />       (command "OFFSET" dis_orig na pt_oo+ "")<br />       (ssadd (entlast) ss_oo)<br />       (command "OFFSET" dis_orig na pt_oo- "")<br />       (ssadd (entlast) ss_oo)<br /> <br />              (setq  slen (- (sslength ss_oo) 1)) <br />              (setq  i 0)<br />         (while  (<= i slen)<br />              (setq _oo_n (ssname ss_oo i))<br />              (setq _oo_data (entget _oo_n))<br />              (setq _oo_tc (cdr (assoc '8 _oo_data)))<br />              (setq _oo_data (subst (cons 8 TC) (assoc '8 _oo_data) _oo_data))<br />              (entmod _oo_data)<br />              (setq i (+ i 1))<br />         )<br /> <br />       <br />    ) ;end of while<br />    <br />   <br />   (prin1)<br />   )<br />   [/FONT]<br />

好像太菜了，没有什么资料可以贡献给大家的。介绍大家一个我刚知道的软件（http://zhidao.baidu.com/question/832483.html这里是介绍）(可能别人很早就知道了。)http://www.7-zip.org/zh-cn/7z429chs.exe这个很厉害，可以把70MB的avi压缩成2MB的文件。

lsjzhj2004

这个早就有了吧，

carrot1983

我知道早就有啦，就是不知道哪里找啊，谁有上传一下呢。
我找到的别人的，有一个是需要定偏移方向的，有一个是好像2000以上才能用的。
R14下能用，而且不用定偏移方向的。好像没有。

phoenixdjq

vl-***的函数在r14下是不能用的
只有高级版本才能用
我以前编过一个程序，就是因为用的vl-***系列函数，导致错误了
最后没有办法，只好不用r14了
现在好象除了一些软件必须用r14，如果能不用，就尽量不要再用了

ygrzz

这CAD真有奥妙的地方，版本这么老了可还有好多人不舍得放弃~~

shute05

新版本还是较好的

e2002

7-zip 是 GPL 软件, 推荐大家换掉授权条件苛刻基本只能使用 D 版得 WinRAR