源码申请:增加记忆
本帖最后由 先进者 于 2012-4-21 13:33 编辑因为工作中排料带的时候经常用到,所以请帮忙加个记忆,就在当前环境加记忆就好了,我对编程是个小白 ;角度阵列程序;(2005.8.5胡晓航(Angle array routine）,比AutoCAD的阵列容易得多。
(defun C:AAR ( / ss ang bp cnt dist d)
(PRINC "\n 角度阵列 ")
(cond
((setq ss (ssget))
(initget 1)
(setq bp (getpoint "\n基点： "))
(initget 1)
(setq ang
(getangle bp "\n阵列方向： "))
(initget 7)
(setq dist
(getdist "\n对象间距： "))
(initget 7)
(setq cnt (getint "\n对象个数： "))
(setq d 0.0)
(setvar "cmdecho" 0)
(command "_.undo" "_g"
"_.copy" ss "" "_m" bp)
(repeat (1- cnt)
(command
(polar bp ang (setq d (+ d dist)))))
(command "" "_.undo" "_e")
)
)
(princ)
)
;* UANGLE User interface angle function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default real in rads is
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil for none).
;*
(defun uangle (bit kwd msg def bpt / inp)
(if def
(setq msg (strcat "\n >> " msg " < " (angtos def) " >: ")
bit (* 2 (fix (/ bit 2)))
)
(if (= " " (substr msg (strlen msg) 1)) ;no def, if last char is space
(setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
(setq msg (strcat "\n >> " msg " : ")) ;else msg OK
) );if,if
(initget bit kwd)
(setq inp
(if bpt
(getangle msg bpt)
(getangle msg)
) )
(if inp inp def)
);defun
;* UINT User interface integer function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default integer is added as <DEF> (nil
;* for none), and a : is added.
;*
(defun uint (bit kwd msg def / inp)
(if def ;test for a default
(setq msg (strcat "\n >> " msg " < " (itoa def) " >: ") ;string'em with default
bit (* 2 (fix (/ bit 2)));a default and no null bit code conflict so
) ;this reduces bit by 1 if odd, to allow null
(if (= " " (substr msg (strlen msg) 1)) ;no def, if last char is space
(setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
(setq msg (strcat "\n >> " msg " : ")) ;else msg OK
) );if,if
(initget bit kwd)
(setq inp (getint msg)) ;use the GETINT function
(if inp inp def) ;compare the results, return appropriate value
);defun
;* UDIST User interface distance function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added. BPT is base point (nil for none).
;*
(defun udist (bit kwd msg def bpt / inp)
(if def ;test for a default
(setq msg (strcat "\n >> " msg " < " (rtos def) " >: ") ;string'emwith default
bit (* 2 (fix (/ bit 2))) ;a default and no null bit code conflict so
);setq ;this reduces bit by 1 if odd, to allow null
(if (= " " (substr msg (strlen msg) 1)) ;no def, if last char is space
(setq msg (strcat "\n >> " (substr msg 1 (1- (strlen msg))) " : ")) ;then strip space
(setq msg (strcat "\n >> " msg " : ")) ;else msg OK
) );if,if
(initget bit kwd)
(setq inp
(if bpt ;check for a base point
(getdist msg bpt) ;and use it in the GET vl-cmdfs
(getdist msg)
) );setq&if
(if inp inp def) ;compare the results, return appropriate value
);defun
(defun C:AAR (/ ss ang bp cnt dist d)
(PRINC "\n 角度阵列 ")
(cond
((setq ss (ssget))
(initget 1)
(setq bp (getpoint "\n基点： ")
ang (uangle 1 "" "阵列方向" *Ang* bp)
dist (udist 7 "" "对像间距" *Dist* bp)
cnt (uint 7 "" "对像个数" *Cnt*)
*Ang* ang
*Dist* dist
*Cnt* cnt
d 0.0
)
(setvar "cmdecho" 0)
(command "_.undo" "_g" "_.copy" ss "" "_m" bp)
(repeat (1- cnt)
(command
(polar bp ang (setq d (+ d dist)))
)
)
(command "" "_.undo" "_e")
)
)
(princ)
)
记忆什么?说清楚 本帖最后由 先进者 于 2012-4-24 15:13 编辑
Andyhon 发表于 2012-4-21 13:16 http://bbs.mjtd.com/static/image/common/back.gif
使用中发现一个问题,,我输入的对象间距与实际不一样,阵列方向本来是水平方向,实际阵列出来的不对,请修改一下好吗
遇到了一个很奇怪的事情,同样的图元,有时候阵列有问题,有时候阵列没有问题,
怎么会有这样的问题出现,请大师找下原因
查是否設有UCS且在使用中 我基本上可以确定没有动过UCS
以前就有这个问题,
在没加记忆以前用源程序的时候,会出现最靠近源图的那个图元与源图位置不对,
其他图元位置相对源图位置是对的,很奇怪,,,,,
这个问题遇到了好几次了,现在都不怎么敢用快速阵列了,
呵呵,万一哪天忘检查了,肯定死的很惨
另一个猜想...
关掉捕捉再试
若还不行请上传样本文件(*.Dwg)以利查验 非常好用，谢谢 这个问题别浪费您的时间了 I don't understand .
页:
[1]