单线变双线源码，求增加封闭端点

言社长

以下是无痕前辈在本坛的一个单线变双线的源码：

2. (defun c:x2 (/ ss vss dist)
   
3.     (vl-load-com)
   
4.    (princ "\n单线变双v.1.1-------by 无痕.2004.2\n选择要变双的曲线:")
   
5.    (setq ss (ssget  '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline,XLine")) )
   
6.   vss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
   
7.          dist (getdist "\n输入偏移距离:"))
   
8.    (vlax-for obj vss (vla-offset obj dist)(vla-offset obj (- 0 dist))(vla-erase obj));删除原线
   
9. )

(defun c:x2 (/ ss vss dist)<br />     (vl-load-com)<br />    (princ "\n单线变双v.1.1-------by 无痕.2004.2\n选择要变双的曲线:")<br />    (setq ss (ssget  '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline,XLine")) )<br />   vss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))<br />          dist (getdist "\n输入偏移距离:"))<br />    (vlax-for obj vss (vla-offset obj dist)(vla-offset obj (- 0 dist))(vla-erase obj));删除原线<br /> )

演示如下：

哪位前辈能帮我改成：

增加一个选项“是否封闭”，实现下图的效果：

另外，有没有逆向操作的程序呢，


就是在小于等于某个距离下，把双线变成单线？？
期待前辈们指教！！

kwok

简单加了一下.

2. ;;;;;;;单线双偏并封口
   
3. (defun c:tt (/ ss dist en e1 e2 i p1 p2 p3 p4 yn lay clay olay)
   
4.     (vl-load-com)
   
5.    (princ "\n单线变双v.1.1-------by 无痕.2004.2\n选择要变双的曲线:")
   
6.    (setq ss (ssget  '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline")) )
   
7.          dist (getdist "\n输入偏移距离:"))
   
8.   (initget "Y N ")
   
9.   (setq yn (getkword "\n[不封口<N>/封口<Y>]<N>:"))
   
10.   (if (= yn "")(setq yn "N"))
    
11.   (setq i 0)
    
12.   (repeat (sslength ss)
    
13.           (setq obj (vlax-ename->vla-object(ssname ss i)) i (1+ i))
    
14.      (vla-offset obj dist) (setq e1 (entlast))
    
15.      (vla-offset obj (- 0 dist)) (setq e2 (entlast))
    
16.      (vla-erase obj);删除原线
    
17. (if (= yn "Y")(progn
    
18.       (setq lay (entget  e1)
    
19.            clay (cdr (assoc 8  lay))
    
20.            olay (getvar "clayer"))
    
21.       (setvar "clayer" clay)
    
22.      (setq p1(vlax-curve-getstartpoint e1)
    
23.            p2(vlax-curve-getendpoint e1)
    
24.            p3(vlax-curve-getstartpoint e2)
    
25.            p4(vlax-curve-getendpoint e2))
    
26. (command ".pline" "non" p1 "non" p3 ""  ".pline" "non" p2 "non" p4 "")
    
27. (setvar "clayer" olay)
    
28.    ))
    
29. )
    
30. (princ))

;;;;;;;单线双偏并封口<br /> (defun c:tt (/ ss dist en e1 e2 i p1 p2 p3 p4 yn lay clay olay)<br />     (vl-load-com)<br />    (princ "\n单线变双v.1.1-------by 无痕.2004.2\n选择要变双的曲线:")<br />    (setq ss (ssget  '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline")) )<br />          dist (getdist "\n输入偏移距离:"))<br />   (initget "Y N ")<br />   (setq yn (getkword "\n[不封口<N>/封口<Y>]<N>:"))<br />   (if (= yn "")(setq yn "N"))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />           (setq obj (vlax-ename->vla-object(ssname ss i)) i (1+ i))<br />      (vla-offset obj dist) (setq e1 (entlast))<br />      (vla-offset obj (- 0 dist)) (setq e2 (entlast))<br />      (vla-erase obj);删除原线<br /> (if (= yn "Y")(progn<br />       (setq lay (entget  e1)<br />            clay (cdr (assoc 8  lay))<br />            olay (getvar "clayer"))<br />       (setvar "clayer" clay)<br />      (setq p1(vlax-curve-getstartpoint e1)<br />            p2(vlax-curve-getendpoint e1)<br />            p3(vlax-curve-getstartpoint e2)<br />            p4(vlax-curve-getendpoint e2))<br /> (command ".pline" "non" p1 "non" p3 ""  ".pline" "non" p2 "non" p4 "")<br /> (setvar "clayer" olay)<br />    ))<br /> )<br /> (princ))

言社长

热心的朋友帮助下我

言社长

kwok 发表于 2016-1-11 14:08
简单加了一下.

感谢你的回复,加得很好.不过你用的是COMMAND,导致最后生成的对象的属性和原来SSGET的不一样,最后生成的对象是当前层的属性.

bai2000

能把原来线不删变为中心线更好

xyp1964

;; 伪源码，用不上别下载

kwok

言社长 发表于 2016-1-11 15:03
感谢你的回复,加得很好.不过你用的是COMMAND,导致最后生成的对象的属性和原来SSGET的不一样,最后生成的对 ...

3楼已更新.

香田里浪人

bai2000 发表于 2016-1-11 15:46
能把原来线不删变为中心线更好

简单， (vla-erase obj);删除原线----改为 ;;(vla-erase obj);就不删除原线

bai2000

回楼上：怎么改为中心线呢？

13993359550

这个强大呀