;***********************今天又在单位把程序优化了一下*************************
;本程序的设计目的是：在某矩形面域内按照均匀分布粘贴程序运行前带基点复制的某一图元
(defun c:fb (/ a b);fb为快捷键，用户可根据自己的需要随便改，只要不与CAD中的命令快捷键重复就行
(setq cmdecho-bak (getvar "cmdecho"))
(setvar "cmdecho" 0) ;关闭命令行信息提示
(setq pa (getpoint "\n请指定第一点:"))
(setq pb (getpoint "\n请指定第二点:"));此点可为对角点，也可为同在x轴或y轴上的点
(setq pax (car pa))
(setq pay (cadr pa))
(setq pbx (car pb))
(setq pby (cadr pb))
(or (setq a (getreal"\n横向布置列数<1>:")) (setq a 1.0))
(if(= pax pbx)(setq a 1.0))
(or (setq b (getreal"\n纵向布置行数<1>:")) (setq b 1.0))
(if(= pay pby)(setq b 1.0))
(setq m 1) ;设置循环变量
(while (<= m a) ;while1
(setq mx (+ pax (* (/ (- m 0.5) a) (- pbx pax))))
(setq n 1)
(while (<= n b) ;while2
(setq my (+ pay (* (/ (- n 0.5) b) (- pby pay))))
(setq n (+ n 1))
(setq newp (list mx my 0))
(command "pasteclip" newp)
) ;end while2
(setq m (+ m 1))
);end while1
(setvar "cmdecho" cmdecho-bak)
) ;end defun yeahyeah 发表于 2013-8-6 19:02 static/image/common/back.gif
;***********************今天又在单位把程序优化了一下*************************
;本程序的设计目的 ...
你这操作容易出错
要先复制图元才行
这让多数人难办了啊
感觉是让阵列命令复杂化啊
页:
1
[2]