源码申请:增加记忆

先进者

因为工作中排料带的时候经常用到,所以请帮忙加个记忆,就在当前环境加记忆就好了,我对编程是个小白

2. ;角度阵列程序;(2005.8.5胡晓航(Angle array routine）,比AutoCAD的阵列容易得多。
   
3. 
   
4. (defun C:AAR ( / ss ang bp cnt dist d)
   
5. (PRINC "\n 角度阵列 ")
   
6.   (cond
   
7.     (  (setq ss (ssget))
   
8.        (initget 1)
   
9.        (setq bp (getpoint "\n基点： "))
   
10.        (initget 1)
    
11.        (setq ang
    
12.            (getangle bp "\n阵列方向： "))
    
13.          (initget 7)
    
14.          (setq dist
    
15.            (getdist "\n对象间距： "))
    
16.          (initget 7)
    
17.          (setq cnt (getint "\n对象个数： "))
    
18.          (setq d 0.0)
    
19.          (setvar "cmdecho" 0)
    
20.          (command "_.undo" "_g"
    
21.                   "_.copy" ss "" "_m" bp)
    
22.          (repeat (1- cnt)
    
23.            (command
    
24.                (polar bp ang (setq d (+ d dist)))))
    
25.                (command "" "_.undo" "_e")
    
26.         )
    
27.       )
    
28.       (princ)
    
29. )
    

;角度阵列程序;(2005.8.5胡晓航(Angle array routine）,比<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>的阵列容易得多。<br /> <br /> (defun C:AAR ( / ss ang bp cnt dist d)<br /> (PRINC "\n 角度阵列 ")<br />   (cond<br />     (  (setq ss (ssget))<br />        (initget 1)<br />        (setq bp (getpoint "\n基点： "))<br />        (initget 1)<br />        (setq ang<br />            (getangle bp "\n阵列方向： "))<br />          (initget 7)<br />          (setq dist<br />            (getdist "\n对象间距： "))<br />          (initget 7)<br />          (setq cnt (getint "\n对象个数： "))<br />          (setq d 0.0)<br />          (setvar "cmdecho" 0)<br />          (command "_.undo" "_g"<br />                   "_.copy" ss "" "_m" bp)<br />          (repeat (1- cnt)<br />            (command<br />                (polar bp ang (setq d (+ d dist)))))<br />                (command "" "_.undo" "_e")<br />         )<br />       )<br />       (princ)<br /> )<br />

Andyhon

2. 
   
3. 
   
4. ;* UANGLE User interface angle function
   
5. ;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
   
6. ;* for INITGET. MSG is the prompt string, to which a default real in rads is
   
7. ;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil for none).
   
8. ;*
   
9. (defun uangle (bit kwd msg def bpt / inp)
   
10.   (if def
    
11.     (setq msg (strcat "\n >> " msg " < " (angtos def) " >: ")
    
12.           bit (* 2 (fix (/ bit 2)))
    
13.     )
    
14.     (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
    
15.       (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
    
16.       (setq msg (strcat "\n >> " msg " : "))                ;else msg OK
    
17.   ) );if,if
    
18.   (initget bit kwd)
    
19.   (setq inp
    
20.     (if bpt
    
21.       (getangle msg bpt)
    
22.       (getangle msg)
    
23.   ) )
    
24.   (if inp inp def)
    
25. );defun
    
26. 
    
27. ;* UINT User interface integer function
    
28. ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
    
29. ;* MSG is the prompt string, to which a default integer is added as <DEF> (nil
    
30. ;* for none), and a : is added.
    
31. ;*
    
32. (defun uint (bit kwd msg def / inp)
    
33.   (if def                                                 ;test for a default
    
34.     (setq msg (strcat "\n >> " msg " < " (itoa def) " >: ")      ;string'em with default
    
35.          bit (* 2 (fix (/ bit 2)))  ;a default and no null bit code conflict so
    
36.     )                               ;this reduces bit by 1 if odd, to allow null
    
37.     (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
    
38.       (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
    
39.       (setq msg (strcat "\n >> " msg " : "))                ;else msg OK
    
40.   ) );if,if
    
41.   (initget bit kwd)
    
42.   (setq inp (getint msg))       ;use the GETINT function
    
43.   (if inp inp def)              ;compare the results, return appropriate value
    
44. );defun
    
45. 
    
46. ;* UDIST User interface distance function
    
47. ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
    
48. ;* MSG is the prompt string, to which a default real is added as <DEF> (nil
    
49. ;* for none), and a : is added. BPT is base point (nil for none).
    
50. ;*
    
51. (defun udist (bit kwd msg def bpt / inp)
    
52.   (if def                                              ;test for a default
    
53.     (setq msg (strcat "\n >> " msg " < " (rtos def) " >: ")   ;string'em  with default
    
54.           bit (* 2 (fix (/ bit 2))) ;a default and no null bit code conflict so
    
55.     );setq                          ;this reduces bit by 1 if odd, to allow null
    
56.     (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
    
57.       (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
    
58.       (setq msg (strcat "\n >> " msg " : "))                ;else msg OK
    
59.   ) );if,if
    
60.   (initget bit kwd)
    
61.   (setq inp
    
62.     (if bpt                  ;check for a base point
    
63.       (getdist msg bpt)      ;and use it in the GET vl-cmdfs
    
64.       (getdist msg)
    
65.   ) );setq&if
    
66.   (if inp inp def)           ;compare the results, return appropriate value
    
67. );defun
    
68. 
    
69. (defun C:AAR (/ ss ang bp cnt dist d)
    
70.   (PRINC "\n 角度阵列 ")
    
71.   (cond
    
72.     ((setq ss (ssget))
    
73.      (initget 1)
    
74.      (setq bp (getpoint "\n基点： ")
    
75.            ang (uangle 1 "" "阵列方向" *Ang* bp)
    
76.           dist (udist 7 "" "对像间距" *Dist* bp)
    
77.            cnt (uint 7 "" "对像个数" *Cnt*)
    
78. 
    
79.          *Ang* ang
    
80.         *Dist* dist
    
81.          *Cnt* cnt
    
82.              d 0.0
    
83.      )
    
84.      (setvar "cmdecho" 0)
    
85.      (command "_.undo" "_g" "_.copy" ss "" "_m" bp)
    
86.      (repeat (1- cnt)
    
87.        (command
    
88.          (polar bp ang (setq d (+ d dist)))
    
89.        )
    
90.      )
    
91.      (command "" "_.undo" "_e")
    
92.     )
    
93.   )
    
94.   (princ)
    
95. )
    

<br /> <br /> ;* UANGLE User interface angle function<br /> ;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as<br /> ;* for INITGET. MSG is the prompt string, to which a default real in rads is<br /> ;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil for none).<br /> ;*<br /> (defun uangle (bit kwd msg def bpt / inp)<br />   (if def<br />     (setq msg (strcat "\n >> " msg " < " (angtos def) " >: ")<br />           bit (* 2 (fix (/ bit 2)))<br />     )<br />     (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space<br />       (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space<br />       (setq msg (strcat "\n >> " msg " : "))                ;else msg OK<br />   ) );if,if<br />   (initget bit kwd)<br />   (setq inp<br />     (if bpt<br />       (getangle msg bpt)<br />       (getangle msg)<br />   ) )<br />   (if inp inp def)<br /> );defun<br /> <br /> ;* UINT User interface integer function<br /> ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.<br /> ;* MSG is the prompt string, to which a default integer is added as <DEF> (nil<br /> ;* for none), and a : is added.<br /> ;*<br /> (defun uint (bit kwd msg def / inp)<br />   (if def                                                 ;test for a default<br />     (setq msg (strcat "\n >> " msg " < " (itoa def) " >: ")      ;string'em with default<br />          bit (* 2 (fix (/ bit 2)))  ;a default and no null bit code conflict so<br />     )                               ;this reduces bit by 1 if odd, to allow null<br />     (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space<br />       (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space<br />       (setq msg (strcat "\n >> " msg " : "))                ;else msg OK<br />   ) );if,if<br />   (initget bit kwd)<br />   (setq inp (getint msg))       ;use the GETINT function<br />   (if inp inp def)              ;compare the results, return appropriate value<br /> );defun<br /> <br /> ;* UDIST User interface distance function<br /> ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.<br /> ;* MSG is the prompt string, to which a default real is added as <DEF> (nil<br /> ;* for none), and a : is added. BPT is base point (nil for none).<br /> ;*<br /> (defun udist (bit kwd msg def bpt / inp)<br />   (if def                                              ;test for a default<br />     (setq msg (strcat "\n >> " msg " < " (rtos def) " >: ")   ;string'em  with default<br />           bit (* 2 (fix (/ bit 2))) ;a default and no null bit code conflict so<br />     );setq                          ;this reduces bit by 1 if odd, to allow null<br />     (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space<br />       (setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space<br />       (setq msg (strcat "\n >> " msg " : "))                ;else msg OK<br />   ) );if,if<br />   (initget bit kwd)<br />   (setq inp<br />     (if bpt                  ;check for a base point<br />       (getdist msg bpt)      ;and use it in the GET vl-cmdfs<br />       (getdist msg)<br />   ) );setq&if<br />   (if inp inp def)           ;compare the results, return appropriate value<br /> );defun<br /> <br /> (defun C:AAR (/ ss ang bp cnt dist d)<br />   (PRINC "\n 角度阵列 ")<br />   (cond<br />     ((setq ss (ssget))<br />      (initget 1)<br />      (setq bp (getpoint "\n基点： ")<br />            ang (uangle 1 "" "阵列方向" *Ang* bp)<br />           dist (udist 7 "" "对像间距" *Dist* bp)<br />            cnt (uint 7 "" "对像个数" *Cnt*)<br /> <br />          *Ang* ang<br />         *Dist* dist<br />          *Cnt* cnt<br />              d 0.0<br />      )<br />      (setvar "cmdecho" 0)<br />      (command "_.undo" "_g" "_.copy" ss "" "_m" bp)<br />      (repeat (1- cnt)<br />        (command<br />          (polar bp ang (setq d (+ d dist)))<br />        )<br />      )<br />      (command "" "_.undo" "_e")<br />     )<br />   )<br />   (princ)<br /> )<br />

danxingpen

记忆什么?说清楚

先进者

Andyhon 发表于 2012-4-21 13:16

使用中发现一个问题,,我输入的对象间距与实际不一样,阵列方向本来是水平方向,实际阵列出来的不对,请修改一下好吗


遇到了一个很奇怪的事情,同样的图元,有时候阵列有问题,有时候阵列没有问题,

怎么会有这样的问题出现,请大师找下原因

Andyhon

查是否設有UCS且在使用中

先进者

我基本上可以确定没有动过UCS
以前就有这个问题,
在没加记忆以前用源程序的时候,会出现最靠近源图的那个图元与源图位置不对,
其他图元位置相对源图位置是对的,很奇怪,,,,,
这个问题遇到了好几次了,现在都不怎么敢用快速阵列了,
呵呵,万一哪天忘检查了,肯定死的很惨

Andyhon

另一个猜想...
关掉捕捉再试
若还不行请上传样本文件(*.Dwg)以利查验

longer1000

非常好用，谢谢

先进者

这个问题别浪费您的时间了

戏男

I don't understand .