如何实现许多个圆同时向内（向外）offset ｘｍｍ

sqqr

向龙哥求教：lisp程序　如何实现许多个圆同时向内或向外offset ｘｍｍ

BDYCAD

(defun c:tT (/ C-RADIUS DIST DXF I OS SS)
(setq ss (ssget '((0 . "CIRCLE"))))
(setq dist (getdist "\n输入偏移距离:"))
(setq i 0 os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(repeat (sslength ss)
(setq DXF (ENTGET (ssname ss i)))
(entmAKE (subst (cons 40 (+ (CDR (ASSOC 40 DXF)) dist)) (assoc 40 DXF) DXF))
(setq i (1+ i))
)
(setvar "osmode" os)
(setvar "cmdecho" 1)
)

meflying

2. (defun c:test( / ss dist i ent)
3.    (vl-load-com)
4.    (setq ss (ssget '((0 . "CIRCLE"))))
5.    (setq dist (getdist "\n输入偏移距离:"))
6.    (setq i 0)
7.    (repeat (sslength ss)
8.        (setq ent (ssname ss i))
9.        (if (> (cdr (assoc 40 (entget ent))) dist)
10.            (vla-offset (vlax-ename->vla-object ent) (- dist))
11.        )
12.        (vla-offset (vlax-ename->vla-object ent) dist)
13.        (setq i (1+ i))
14.    )
15.    (princ)
16. )

(defun c:test( / ss dist i ent)    (vl-load-com)    (setq ss (ssget '((0 . "CIRCLE"))))    (setq dist (getdist "\n输入偏移距离:"))    (setq i 0)    (repeat (sslength ss)        (setq ent (ssname ss i))        (if (> (cdr (assoc 40 (entget ent))) dist)            (vla-offset (vlax-ename->vla-object ent) (- dist))        )        (vla-offset (vlax-ename->vla-object ent) dist)        (setq i (1+ i))    )    (princ) )

xstlf

呵呵，好开心，这题我也能搞定了。不再开一个话题了，我想再请问大家对N个数按其大小排序，在哪可以找到呀。我以前好象见到过，现在找不到了，谁找到贴到这儿来让我看看好吗？

sqqr

向内　或　向外offset ｘｍｍ，应有可选方向选项！！！

xyp1964

学习meflying的程序：

2. ;;;多个圆同时向内或向外偏移(offset )定距
3. (defun c:test028 (/ ss i ent)
4.    (vl-load-com)
5.    (setq  ss     (ssget '((0 . "CIRCLE")))
6.   dist (ureal 1 "" "\n输入偏移距离" dist)
7.   txt   (ukword 1 "1 2" "\n请选择偏移形式：1-向外/2-向内" txt)
8.   i       -1
9.    )
10.    (while (setq ent (ssname ss (setq i (1+ i))))
11.        (if  (= txt "1")
12.            (vla-offset (vlax-ename->vla-object ent) dist)
13.            (if (> (cdr (assoc 40 (entget ent))) dist)
14.   (vla-offset (vlax-ename->vla-object ent) (- dist))
15.            )
16.        )
17.    )
18.    (princ)
19. )
20. (defun ureal (bit kwd msg def / inp)
21.    (if def
22.        (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
23.      bit (* 2 (fix (/ bit 2)))
24.        )
25.        (setq msg (strcat "\n" msg ": "))
26.    )
27.    (initget bit kwd)
28.    (setq inp (getreal msg))
29.    (if inp
30.        inp
31.        def
32.    )
33. )
34. (defun ukword (bit kwd msg def / inp)
35.    (if (and def (/= def ""))
36.        (setq msg (strcat "\n" msg "<" def ">:")
37.      bit (* 2 (fix (/ bit 2)))
38.        )
39.        (setq msg (strcat "\n" msg ":"))
40.    )
41.    (initget bit kwd)
42.    (setq inp (getkword msg))
43.    (if inp
44.        inp
45.        def
46.    )
47. )

;;;多个圆同时向内或向外偏移(offset )定距 (defun c:test028 (/ ss i ent)    (vl-load-com)    (setq  ss     (ssget '((0 . "CIRCLE")))   dist (ureal 1 "" "\n输入偏移距离" dist)   txt   (ukword 1 "1 2" "\n请选择偏移形式：1-向外/2-向内" txt)   i       -1    )    (while (setq ent (ssname ss (setq i (1+ i))))        (if  (= txt "1")            (vla-offset (vlax-ename->vla-object ent) dist)            (if (> (cdr (assoc 40 (entget ent))) dist)   (vla-offset (vlax-ename->vla-object ent) (- dist))            )        )    )    (princ) ) (defun ureal (bit kwd msg def / inp)    (if def        (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")      bit (* 2 (fix (/ bit 2)))        )        (setq msg (strcat "\n" msg ": "))    )    (initget bit kwd)    (setq inp (getreal msg))    (if inp        inp        def    ) ) (defun ukword (bit kwd msg def / inp)    (if (and def (/= def ""))        (setq msg (strcat "\n" msg "<" def ">:")      bit (* 2 (fix (/ bit 2)))        )        (setq msg (strcat "\n" msg ":"))    )    (initget bit kwd)    (setq inp (getkword msg))    (if inp        inp        def    ) )

sqqr

谢谢xyp1964，献上鲜花一支

zwf100

meflying 发表于 2004-12-25 15:24

版主你好，为了区别偏移的线和原来的线，能否将偏移的线改个颜色，或者改到指定图层，如当前层