修改倒角和圆角

llsheng_73

下午看到个帖子，说是很急，要求点选一个矩形框（左理角为L=1.0的倒角，右下角为R=1.0的圆角），要求把倒角和圆角都改成0.9，当时想写的，结果耽搁了，现在写出来找不到那个帖子了，也没记住那位兄弟的名字，只好给他放这里了

1. (defun c:DJYJ(/ a b continue);;
   
2.   (defun plinexy(e / a q m p);;;LWPolyline,POLYLINE顶点,去掉完全重合点
   
3.     (setq a(vlax-ename->vla-object e)
   
4.           q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
   
5.           m(vla-get-objectname a)a 0
   
6.           m(if(= m"AcDb3dPolyline")3 2))
   
7.     (repeat(/(length q)m)
   
8.       (cond((= m 2)(setq p1(list(nth a q)(nth(+ a 1)q))))
   
9.            ((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
   
10.       (setq p(if(member p1 p)p(append p(list p1)))
    
11.             a(+ a m)))
    
12.     p)
    
13.   (setq continue t)
    
14.   (while continue
    
15.      (if (setq a(car(entsel"选择要修改倒角的圆角的多线段右键退出")))
    
16.        (progn
    
17.          (setq b(entget a))
    
18.          (if(vl-string-search"LINE"(cdr(assoc 0 b)))
    
19.            (entmod(setq a(vl-sort(plinexy a)'(lambda (s1 s2)(< (cadr s1) (cadr s2))))
    
20.                         b(subst(list 10(-(car(car a))0.1)(cadr(car a)))(cons 10(car a))b)
    
21.                         b(subst(list 10(+(car(cadr a))0.1)(cadr(cadr a)))(cons 10(cadr a))b)
    
22.                         b(subst(list 10(car(caddr a))(-(cadr(caddr a))0.1))(cons 10(caddr a))b)
    
23.                         b(subst(list 10(car(cadddr a))(-(cadr(cadddr a))0.1))(cons 10(cadddr a))b)))
    
24.            )
    
25.          )
    
26.        (setq continue nil))
    
27.     )
    
28.   )

(defun c:DJYJ(/ a b continue);;<br />   (defun plinexy(e / a q m p);;;LWPolyline,POLYLINE顶点,去掉完全重合点<br />     (setq a(vlax-ename->vla-object e)<br />           q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))<br />           m(vla-get-objectname a)a 0<br />           m(if(= m"AcDb3dPolyline")3 2))<br />     (repeat(/(length q)m)<br />       (cond((= m 2)(setq p1(list(nth a q)(nth(+ a 1)q))))<br />            ((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))<br />       (setq p(if(member p1 p)p(append p(list p1)))<br />             a(+ a m)))<br />     p)<br />   (setq continue t)<br />   (while continue<br />      (if (setq a(car(entsel"选择要修改倒角的圆角的多线段右键退出")))<br />        (progn<br />          (setq b(entget a))<br />          (if(vl-string-search"LINE"(cdr(assoc 0 b)))<br />            (entmod(setq a(vl-sort(plinexy a)'(lambda (s1 s2)(< (cadr s1) (cadr s2))))<br />                         b(subst(list 10(-(car(car a))0.1)(cadr(car a)))(cons 10(car a))b)<br />                         b(subst(list 10(+(car(cadr a))0.1)(cadr(cadr a)))(cons 10(cadr a))b)<br />                         b(subst(list 10(car(caddr a))(-(cadr(caddr a))0.1))(cons 10(caddr a))b)<br />                         b(subst(list 10(car(cadddr a))(-(cadr(cadddr a))0.1))(cons 10(cadddr a))b)))<br />            )<br />          )<br />        (setq continue nil))<br />     )<br />   )

MENGZE

漂亮，真是我所要的！

llsheng_73

MENGZE 发表于 2013-12-2 23:45
漂亮，真是我所要的！

你能用得上就好，反正我是用不上的

sanji14

你好,我很需要这个程序,不知大师可以帮我修改变成我如图那样吗>谢谢了
[img][/img]

琴剑江山_10184

llsheng_73 发表于 2013-12-3 15:59
你能用得上就好，反正我是用不上的

(defun c:txy(/ s s2 e1 e2 m n)
  (if(setq s(ssget'((0 . "circle,arc")(40 . 4.5))))
    (progn
      (setq s2(ssadd)n 0)
      (repeat(sslength s)
        (setq e1(ssname s n)n(1+ n))
        (if(setq e2(ssget"X"(list'(0 . "circle,arc")'(40 . 7)(assoc 10(entget e1)))))
          (progn(setq s2(ssadd e1 s2)m 0)
            (repeat(sslength e2)
              (setq s2(ssadd(ssname e2 m)s2)
                    m(1+ m))
              ))
          )))
    )
  (sssetfirst nil s2)
  )
73大师，看到你回复别人的贴子，弄同心圆的，能不能改成手动输入 要不就点选两个圆做参照？