自动连上

357785513

各位大虾,
我想把圆灯缩小一半后灯两边的连线还是连上的,但每个灯的位还不能变动它,有没有更块的办法.烟为以前酒詀的灯做大了
现在又想改小,所以要缩小

Andyhon

2. 
   
3. 
   
4. (Defun Cp2txt_Aux (ent pto)
   
5.    (command "Scale" ent "" pto fac)
   
6.    (command "change" (mapcar '- pto xx) "" (mapcar '- pto dda))
   
7.    (command "change" (mapcar '+ pto xx) "" (mapcar '+ pto dda))
   
8. )
   
9. 
   
10. 
    
11. ;;; For test only
    
12. 
    
13. (Defun C:Cp2txt ()
    
14.    (setq ss (ssget '((2 . "ltg"))))
    
15.    (setq fac (getreal "\n 比率: "))   ; say 0.5
    
16. 
    
17.    (setq i 0)
    
18.    (setq ee (ssname ss i)
    
19.         pts (acet-ent-geomextents ee)           ; acet-ent-geomextents / Required ET
    
20.          xx (- (caadr pts) (caar pts))
    
21.          dd (* xx (- 1 fac) 0.5)
    
22.         dda (list dd 0)
    
23.          xx (list (* xx 0.5) 0)
    
24.    )
    
25.    (while (setq ee (ssname ss i))
    
26.      (Cp2txt_Aux ee (apply 'mid_pt pts))        ; mid_pt 站内搜
    
27.      (setq i (1+ i))
    
28.      (and
    
29.        (setq ee (ssname ss i))
    
30.        (setq pts (acet-ent-geomextents ee))
    
31.    ) )
    
32. )
    
33. 
    

<br /> <br /> (Defun Cp2txt_Aux (ent pto)<br />    (command "Scale" ent "" pto fac)<br />    (command "change" (mapcar '- pto xx) "" (mapcar '- pto dda))<br />    (command "change" (mapcar '+ pto xx) "" (mapcar '+ pto dda))<br /> )<br /> <br /> <br /> ;;; For test only<br /> <br /> (Defun C:Cp2txt ()<br />    (setq ss (ssget '((2 . "ltg"))))<br />    (setq fac (getreal "\n 比率: "))   ; say 0.5<br /> <br />    (setq i 0)<br />    (setq ee (ssname ss i)<br />         pts (acet-ent-geomextents ee)           ; acet-ent-geomextents / Required ET<br />          xx (- (caadr pts) (caar pts))<br />          dd (* xx (- 1 fac) 0.5)<br />         dda (list dd 0)<br />          xx (list (* xx 0.5) 0)<br />    )<br />    (while (setq ee (ssname ss i))<br />      (Cp2txt_Aux ee (apply 'mid_pt pts))        ; mid_pt 站内搜<br />      (setq i (1+ i))<br />      (and<br />        (setq ee (ssname ss i))<br />        (setq pts (acet-ent-geomextents ee))<br />    ) )<br /> )<br /> <br />

YYHappy1314

快捷键是什么呀，没反应呢

仲文玉

缺少函数吧：acet-ent-geomextents

userzhl

需要安装ET

357785513

; 错误: *error* 函数中出错函数被取消
不像四楼所说的那样
但出现了新的问题

xyp1964

yjr111

2. (defun ss2lst (ss / n e lst)
   
3. (repeat (setq n(sslength ss))
   
4.   (setq lst (cons (ssname ss (setq n (1- n))) lst))
   
5. )
   
6. lst
   
7. )
   
8. (defun wbk(e / L_djx lst)
   
9.     (vla-getboundingbox (vlax-ename->vla-object e) 'minp 'maxp)
   
10.     (setq minp (reverse(cdr(reverse(vlax-safearray->list minp))))
    
11.           maxp (reverse(cdr(reverse(vlax-safearray->list maxp))))
    
12.           xminymaxp(list(car minp)(cadr maxp))
    
13.           xmaxyminp(list(car maxp)(cadr minp))
    
14.           lst(list minp xmaxyminp maxp xminymaxp minp)
    
15.           )
    
16.     (entmake (append(list'(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
    
17.                           (cons 90 (length lst)))(mapcar '(lambda (pt)(cons 10 pt)) lst ))
    
18.     )
    
19.     (setq ple(entlast))
    
20.     (ssadd ple pless)
    
21.     (setq L_djx(distance minp maxp)
    
22.           midp (polar minp (angle minp maxp)(/ L_djx 2))
    
23.           )
    
24. )
    
25. (defun c:sfbb(/ kname scnum ss pless liness linelst insertss
    
26.                 insertlst n inserte n cp1 cp2 midp clst elst ple
    
27.                 minp xmaxyminp maxp xminymaxp midp ple  )
    
28.   (command "undo" "be")
    
29.   (setvar 'cmdecho 0)
    
30.   (if (setq insertss (ssget'((0 . "insert")(2 . "ltg"))))
    
31.     (progn
    
32.       (setq pless(ssadd))
    
33.       (setq pick(getvar 'pickbox))
    
34.       (setq scnum(getreal"\n请输入缩放比例<0.5>"))
    
35.       (if(not scnum)(setq scnum 0.5))
    
36.       (repeat (setq n(sslength insertss))
    
37.             (vla-getboundingbox (vlax-ename->vla-object
    
38.             (setq inserte(ssname insertss (setq n(1- n))))) 'minp 'maxp)
    
39.             (setq cp1 (mapcar '(lambda(x)(- x pick))(vlax-safearray->list minp))
    
40.                   cp2 (mapcar '(lambda(x)(+ x pick))(vlax-safearray->list maxp))
    
41.                   midp (polar cp1 (angle cp1 cp2)(/ (distance cp1 cp2) 2))
    
42.                   )
    
43.         (ssget "c" cp1 cp2)
    
44.         (setq clst(cons(cons inserte (ss2lst(ssget "p" '((0 . "line")))))clst))
    
45.         (command "scale" inserte "" midp scnum)
    
46.        )
    
47.        (repeat (setq n(length clst))
    
48.          (setq elst(nth (setq n(1- n)) clst))
    
49.          (wbk (car elst))
    
50.          (command "zoom" "o" ple "")
    
51.          (foreach x (cdr elst)
    
52.            (if (< (distance (setq sp (vlax-curve-getStartPoint x)) midp)
    
53.                   (distance (setq ep (vlax-curve-getendPoint   x)) midp)
    
54.                   )
    
55.              (command "extend" ple "" (nentselp(vlax-curve-getStartPoint x))"")             
    
56.              (command "extend" ple "" (nentselp(vlax-curve-getendPoint   x))"")
    
57.              )
    
58.          )
    
59.          (command "zoom" "p" )
    
60.        )
    
61.       )
    
62.     )
    
63.   (command "erase" pless "")
    
64.   (command "undo" "e")
    
65.   (princ)
    
66.   )

(defun ss2lst (ss / n e lst)<br /> (repeat (setq n(sslength ss))<br />   (setq lst (cons (ssname ss (setq n (1- n))) lst))<br /> )<br /> lst<br /> )<br /> (defun wbk(e / L_djx lst)<br />     (vla-getboundingbox (vlax-ename->vla-object e) 'minp 'maxp)<br />     (setq minp (reverse(cdr(reverse(vlax-safearray->list minp))))<br />           maxp (reverse(cdr(reverse(vlax-safearray->list maxp))))<br />           xminymaxp(list(car minp)(cadr maxp))<br />           xmaxyminp(list(car maxp)(cadr minp))<br />           lst(list minp xmaxyminp maxp xminymaxp minp)<br />           )<br />     (entmake (append(list'(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")<br />                           (cons 90 (length lst)))(mapcar '(lambda (pt)(cons 10 pt)) lst ))<br />     )<br />     (setq ple(entlast))<br />     (ssadd ple pless)<br />     (setq L_djx(distance minp maxp)<br />           midp (polar minp (angle minp maxp)(/ L_djx 2))<br />           )<br /> )<br /> (defun c:sfbb(/ kname scnum ss pless liness linelst insertss<br />                 insertlst n inserte n cp1 cp2 midp clst elst ple<br />                 minp xmaxyminp maxp xminymaxp midp ple  )<br />   (command "undo" "be")<br />   (setvar 'cmdecho 0)<br />   (if (setq insertss (ssget'((0 . "insert")(2 . "ltg"))))<br />     (progn<br />       (setq pless(ssadd))<br />       (setq pick(getvar 'pickbox))<br />       (setq scnum(getreal"\n请输入缩放比例<0.5>"))<br />       (if(not scnum)(setq scnum 0.5))<br />       (repeat (setq n(sslength insertss))<br />             (vla-getboundingbox (vlax-ename->vla-object<br />             (setq inserte(ssname insertss (setq n(1- n))))) 'minp 'maxp)<br />             (setq cp1 (mapcar '(lambda(x)(- x pick))(vlax-safearray->list minp))<br />                   cp2 (mapcar '(lambda(x)(+ x pick))(vlax-safearray->list maxp))<br />                   midp (polar cp1 (angle cp1 cp2)(/ (distance cp1 cp2) 2))<br />                   )<br />         (ssget "c" cp1 cp2)<br />         (setq clst(cons(cons inserte (ss2lst(ssget "p" '((0 . "line")))))clst))<br />         (command "scale" inserte "" midp scnum)<br />        )<br />        (repeat (setq n(length clst))<br />          (setq elst(nth (setq n(1- n)) clst))<br />          (wbk (car elst))<br />          (command "zoom" "o" ple "")<br />          (foreach x (cdr elst)<br />            (if (< (distance (setq sp (vlax-curve-getStartPoint x)) midp)<br />                   (distance (setq ep (vlax-curve-getendPoint   x)) midp)<br />                   )<br />              (command "extend" ple "" (nentselp(vlax-curve-getStartPoint x))"")             <br />              (command "extend" ple "" (nentselp(vlax-curve-getendPoint   x))"")<br />              )<br />          )<br />          (command "zoom" "p" )<br />        )<br />       )<br />     )<br />   (command "erase" pless "")<br />   (command "undo" "e")<br />   (princ)<br />   )

461045462

yjr111 发表于 2012-8-7 19:49

谢谢分享。
没有到达楼主的要求，线条未连接到改变后的圆

461045462

Andyhon 发表于 2012-8-7 15:49

谢谢分享！
试了试，好像有误
比率: 0.5
【错误】no function definition: nil!*取消*