求批量偏移程序

龙吟小调

望高手帮忙编一个，明币不行，人民币支付也可以

Gu_xl

1. ;;批量偏移 By Gu_xl 2013.04.01
   
2. (defun c:py (/ CLOCKWISEP OFFSET KD SS N EN kd0)
   
3.   (defun CLOCKWISEP (en / lw minp MaxP lst)
   
4.     (setq lw (vlax-ename->vla-object en))
   
5.     (vla-GetBoundingBox lw 'MinP 'MaxP)
   
6.     (setq
   
7.       minp (vlax-safearray->list minp)
   
8.       MaxP (vlax-safearray->list MaxP)
   
9.       lst  (mapcar
   
10.              (function
    
11.                (lambda (x)
    
12.                  (vlax-curve-getParamAtPoint
    
13.                    lw
    
14.                    (vlax-curve-getClosestPointTo lw x)
    
15.                    )
    
16.                  )
    
17.                )
    
18.              (list minp
    
19.                    (list (car minp) (cadr MaxP))
    
20.                    MaxP
    
21.                    (list (car MaxP) (cadr minp))
    
22.                    )
    
23.              )
    
24.       )
    
25.     (if (or
    
26.           (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
    
27.           (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
    
28.           (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
    
29.           (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    
30.           )
    
31.       t
    
32.       )
    
33.     )
    
34.   (initget 7 "W N S  ")
    
35.   (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))
    
36.   (if (= "" kd0)
    
37.     (setq kd0 "W")
    
38.     )
    
39.   (initget 6)
    
40.   (setq offset (getreal "\n[输入偏移距离]<0.5>"))
    
41.   (if (null offset)
    
42.     (setq offset 0.5)
    
43.     )
    
44.   (initget 7 "Y N  ")
    
45.   (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
    
46.   (if (= kd "")
    
47.     (setq kd "N")
    
48.     )
    
49.   (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))
    
50.     (repeat (setq n (sslength ss))
    
51.       (setq en (ssname ss (setq n (1- n))))
    
52.       (cond
    
53.         ((or (= "ARC" (cdr (assoc 0 (entget en))))
    
54.              (= "CIRCLE" (cdr (assoc 0 (entget en))))
    
55.              )
    
56.          (cond ((= kd0 "W")
    
57.                 (vla-offset (vlax-ename->vla-object en) offset)
    
58.                 )
    
59.                ((= kd0 "N")
    
60.                 (vla-offset (vlax-ename->vla-object en) (- offset))
    
61.                 )
    
62.                (t
    
63.                 (vla-offset (vlax-ename->vla-object en) offset)
    
64.                 (vla-offset (vlax-ename->vla-object en) (- offset))
    
65.                 )
    
66.                )
    
67.          )
    
68.         (t
    
69.          (cond ((= kd0 "W")
    
70.                 (if (CLOCKWISEP en)
    
71.                   (vla-offset (vlax-ename->vla-object en) (- offset))
    
72.                   (vla-offset (vlax-ename->vla-object en) offset)
    
73.                   )
    
74.                 )
    
75.                ((= kd0 "N")
    
76.                 (if (CLOCKWISEP en)
    
77.                   (vla-offset (vlax-ename->vla-object en) offset)
    
78.                   (vla-offset (vlax-ename->vla-object en) (- offset))
    
79.                   )
    
80.                 )
    
81.                (t
    
82.                 (vla-offset (vlax-ename->vla-object en) offset)
    
83.                 (vla-offset (vlax-ename->vla-object en) (- offset))
    
84.                 )
    
85.                )
    
86. 
    
87.          )
    
88.         )
    
89.       (if (= kd "Y")
    
90.         (entdel en)
    
91.         )
    
92.       )
    
93.     )
    
94.   (princ)
    
95.   )
    

;;批量偏移 By Gu_xl 2013.04.01<br /> (defun c:py (/ CLOCKWISEP OFFSET KD SS N EN kd0)<br />   (defun CLOCKWISEP (en / lw minp MaxP lst)<br />     (setq lw (vlax-ename->vla-object en))<br />     (vla-GetBoundingBox lw 'MinP 'MaxP)<br />     (setq<br />       minp (vlax-safearray->list minp)<br />       MaxP (vlax-safearray->list MaxP)<br />       lst  (mapcar<br />              (function<br />                (lambda (x)<br />                  (vlax-curve-getParamAtPoint<br />                    lw<br />                    (vlax-curve-getClosestPointTo lw x)<br />                    )<br />                  )<br />                )<br />              (list minp<br />                    (list (car minp) (cadr MaxP))<br />                    MaxP<br />                    (list (car MaxP) (cadr minp))<br />                    )<br />              )<br />       )<br />     (if (or<br />           (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))<br />           (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))<br />           (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))<br />           (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))<br />           )<br />       t<br />       )<br />     )<br />   (initget 7 "W N S  ")<br />   (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))<br />   (if (= "" kd0)<br />     (setq kd0 "W")<br />     )<br />   (initget 6)<br />   (setq offset (getreal "\n[输入偏移距离]<0.5>"))<br />   (if (null offset)<br />     (setq offset 0.5)<br />     )<br />   (initget 7 "Y N  ")<br />   (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))<br />   (if (= kd "")<br />     (setq kd "N")<br />     )<br />   (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))<br />     (repeat (setq n (sslength ss))<br />       (setq en (ssname ss (setq n (1- n))))<br />       (cond<br />         ((or (= "ARC" (cdr (assoc 0 (entget en))))<br />              (= "CIRCLE" (cdr (assoc 0 (entget en))))<br />              )<br />          (cond ((= kd0 "W")<br />                 (vla-offset (vlax-ename->vla-object en) offset)<br />                 )<br />                ((= kd0 "N")<br />                 (vla-offset (vlax-ename->vla-object en) (- offset))<br />                 )<br />                (t<br />                 (vla-offset (vlax-ename->vla-object en) offset)<br />                 (vla-offset (vlax-ename->vla-object en) (- offset))<br />                 )<br />                )<br />          )<br />         (t<br />          (cond ((= kd0 "W")<br />                 (if (CLOCKWISEP en)<br />                   (vla-offset (vlax-ename->vla-object en) (- offset))<br />                   (vla-offset (vlax-ename->vla-object en) offset)<br />                   )<br />                 )<br />                ((= kd0 "N")<br />                 (if (CLOCKWISEP en)<br />                   (vla-offset (vlax-ename->vla-object en) offset)<br />                   (vla-offset (vlax-ename->vla-object en) (- offset))<br />                   )<br />                 )<br />                (t<br />                 (vla-offset (vlax-ename->vla-object en) offset)<br />                 (vla-offset (vlax-ename->vla-object en) (- offset))<br />                 )<br />                )<br /> <br />          )<br />         )<br />       (if (= kd "Y")<br />         (entdel en)<br />         )<br />       )<br />     )<br />   (princ)<br />   )<br />

liuxu042

可以联系我qq：379539186

Andyhon

图元对象只有圆与矩形框 !?
看演示已有现成的程序,所求何来

simpleye

GU_xl版主这人真好~~~~

龙吟小调

Andyhon 发表于 2013-4-1 10:33
图元对象只有圆与矩形框 !?
看演示已有现成的程序,所求何来

那是别人的东西，不肯与我分享，因为我也用到此插件，所以求程序

龙吟小调

Gu_xl 发表于 2013-4-1 11:04

谢谢G版，程序试用了下挺好的，不过在试用的过程中，发现有点小问题，不知能否麻烦G版忙我改进下，加个偏移后与原来的有颜色区分，望G版帮忙下

Gu_xl

龙吟小调 发表于 2013-4-1 13:14
谢谢G版，程序试用了下挺好的，不过在试用的过程中，发现有点小问题，不知能否麻烦G版忙我改进下，加个偏 ...

这个很简单，希望你自己动手！

龙吟小调

Gu_xl 发表于 2013-4-1 19:23
这个很简单，希望你自己动手！

这几天生病了，没来，谢谢G版，悬赏分要怎么给你，我不会操作，希望指教

【KAIXIN】

2. ;;批量偏移 By Gu_xl 2013.04.01
   
3. (defun c:xx (/ CLOCKWISEP OFFSET KD SS N EN kd0)
   
4.   (defun CLOCKWISEP (en / lw minp MaxP lst)
   
5.     (setq lw (vlax-ename->vla-object en))
   
6.     (vla-GetBoundingBox lw 'MinP 'MaxP)
   
7.     (setq
   
8.       minp (vlax-safearray->list minp)
   
9.       MaxP (vlax-safearray->list MaxP)
   
10.       lst  (mapcar
    
11.              (function
    
12.                (lambda (x)
    
13.                  (vlax-curve-getParamAtPoint
    
14.                    lw
    
15.                    (vlax-curve-getClosestPointTo lw x)
    
16.                    )
    
17.                  )
    
18.                )
    
19.              (list minp
    
20.                    (list (car minp) (cadr MaxP))
    
21.                    MaxP
    
22.                    (list (car MaxP) (cadr minp))
    
23.                    )
    
24.              )
    
25.       )
    
26.     (if (or
    
27.           (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
    
28.           (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
    
29.           (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
    
30.           (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    
31.           )
    
32.       t
    
33.       )
    
34.     )
    
35.   (initget 7 "W N S  ")
    
36.   (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))
    
37.   (if (= "" kd0)
    
38.     (setq kd0 "W")
    
39.     )
    
40.   (initget 6)
    
41.   (setq offset (getreal "\n[输入偏移距离]<0.5>"))
    
42.   (if (null offset)
    
43.     (setq offset 0.5)
    
44.     )
    
45.   (initget 7 "Y N  ")
    
46.   (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
    
47.   (if (= kd "")
    
48.     (setq kd "N")
    
49.     )
    
50.   (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))
    
51.     (repeat (setq n (sslength ss))
    
52.       (setq en (ssname ss (setq n (1- n))))
    
53.       (cond
    
54.         ((or (= "ARC" (cdr (assoc 0 (entget en))))
    
55.              (= "CIRCLE" (cdr (assoc 0 (entget en))))
    
56.              )
    
57.          (cond ((= kd0 "W")
    
58.                 (vla-offset (vlax-ename->vla-object en) offset)
    
59.                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
60.                 )
    
61.                ((= kd0 "N")
    
62.                 (vla-offset (vlax-ename->vla-object en) (- offset))
    
63.                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
64.                 )
    
65.                (t
    
66.                 (vla-offset (vlax-ename->vla-object en) offset)
    
67.                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
68.                 (vla-offset (vlax-ename->vla-object en) (- offset))
    
69.                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
70.                 )
    
71.                )
    
72.          )
    
73.         (t
    
74.          (cond ((= kd0 "W")
    
75.                 (if (CLOCKWISEP en)
    
76.                   (vla-offset (vlax-ename->vla-object en) (- offset))
    
77.                   (vla-offset (vlax-ename->vla-object en) offset)
    
78.                   )
    
79.                   (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
80.                 )
    
81.                ((= kd0 "N")
    
82.                 (if (CLOCKWISEP en)
    
83.                   (vla-offset (vlax-ename->vla-object en) offset)
    
84.                   (vla-offset (vlax-ename->vla-object en) (- offset))
    
85.                   )
    
86.                   (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
87.                 )
    
88.                (t
    
89.                 (vla-offset (vlax-ename->vla-object en) offset)
    
90.                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
91.                 (vla-offset (vlax-ename->vla-object en) (- offset))
    
92.                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
    
93.                 )
    
94.                )
    
95. 
    
96.          )
    
97.         )
    
98.       (if (= kd "Y")
    
99.         (entdel en)
    
100.         )
     
101.       )
     
102.     )
     
103.   (princ)
     
104.   )

;;批量偏移 By Gu_xl 2013.04.01<br /> (defun c:xx (/ CLOCKWISEP OFFSET KD SS N EN kd0)<br />   (defun CLOCKWISEP (en / lw minp MaxP lst)<br />     (setq lw (vlax-ename->vla-object en))<br />     (vla-GetBoundingBox lw 'MinP 'MaxP)<br />     (setq<br />       minp (vlax-safearray->list minp)<br />       MaxP (vlax-safearray->list MaxP)<br />       lst  (mapcar<br />              (function<br />                (lambda (x)<br />                  (vlax-curve-getParamAtPoint<br />                    lw<br />                    (vlax-curve-getClosestPointTo lw x)<br />                    )<br />                  )<br />                )<br />              (list minp<br />                    (list (car minp) (cadr MaxP))<br />                    MaxP<br />                    (list (car MaxP) (cadr minp))<br />                    )<br />              )<br />       )<br />     (if (or<br />           (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))<br />           (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))<br />           (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))<br />           (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))<br />           )<br />       t<br />       )<br />     )<br />   (initget 7 "W N S  ")<br />   (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))<br />   (if (= "" kd0)<br />     (setq kd0 "W")<br />     )<br />   (initget 6)<br />   (setq offset (getreal "\n[输入偏移距离]<0.5>"))<br />   (if (null offset)<br />     (setq offset 0.5)<br />     )<br />   (initget 7 "Y N  ")<br />   (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))<br />   (if (= kd "")<br />     (setq kd "N")<br />     )<br />   (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))<br />     (repeat (setq n (sslength ss))<br />       (setq en (ssname ss (setq n (1- n))))<br />       (cond<br />         ((or (= "ARC" (cdr (assoc 0 (entget en))))<br />              (= "CIRCLE" (cdr (assoc 0 (entget en))))<br />              )<br />          (cond ((= kd0 "W")<br />                 (vla-offset (vlax-ename->vla-object en) offset)<br />                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 )<br />                ((= kd0 "N")<br />                 (vla-offset (vlax-ename->vla-object en) (- offset))<br />                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 )<br />                (t<br />                 (vla-offset (vlax-ename->vla-object en) offset)<br />                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 (vla-offset (vlax-ename->vla-object en) (- offset))<br />                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 )<br />                )<br />          )<br />         (t<br />          (cond ((= kd0 "W")<br />                 (if (CLOCKWISEP en)<br />                   (vla-offset (vlax-ename->vla-object en) (- offset))<br />                   (vla-offset (vlax-ename->vla-object en) offset)<br />                   )<br />                   (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 )<br />                ((= kd0 "N")<br />                 (if (CLOCKWISEP en)<br />                   (vla-offset (vlax-ename->vla-object en) offset)<br />                   (vla-offset (vlax-ename->vla-object en) (- offset))<br />                   )<br />                   (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 )<br />                (t<br />                 (vla-offset (vlax-ename->vla-object en) offset)<br />                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 (vla-offset (vlax-ename->vla-object en) (- offset))<br />                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)<br />                 )<br />                )<br /> <br />          )<br />         )<br />       (if (= kd "Y")<br />         (entdel en)<br />         )<br />       )<br />     )<br />   (princ)<br />   )