luyu9635 发表于 2008-3-11 05:24:00

[原创]阵列改进版

可记录上次的行距，列距和键盘输入的间距，比cad的要快

luyu9635 发表于 2008-3-11 05:30:00

其中子程序是zzxxqq斑竹的，谢谢了

669423907 发表于 2011-4-18 23:27:50

谢谢楼主分享

pb.v@163.com 发表于 2011-7-2 14:29:58

我想改为默认一行的，只要输入步距和列数，还有阵列出的图元变为其他色，能实现吗

pb.v@163.com 发表于 2011-7-2 15:04:15

你好，我的这个阵列想修改为：执行命令-选择对象-输入步距-输入列数-空格OK，如果阵列后图元变为8号色更好，现在的这个LISP输入的是图元间距，而不是步距，谢谢大哥帮忙看看
;;简易矩形阵列
(defun C:PAR()
(vl-load-com)
(setvar "cmdecho" 0)
(command "ucs" "w")
(princ "\n请选择要阵列的物体:")
(while(null(setq en (ssget))))
(setq minx0 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
(setq i 0)
(repeat (sslength en)
   (setq end (ssname en i))
   (setq end_data (entget end))
   (Min_Max)
   (setq i(1+ i))
)
(setq pmin (list minx0 miny0)
      pmax (list maxx0 maxy0))
(setq yc (- maxx0 minx0) xc (- maxy0 miny0))
(if (not hs)(setq hhs 2)(setq hhs (fix hs)))
(if (not ls)(setq lls 2)(setq lls (fix ls)))

(if (not hs)(setq hs hhs))
(initget 6)(setq ls(getint (strcat "\n请输入工站数:<" (itoa lls) ">")))
(if (not ls)(setq ls lls))
(if (not jjj)(setq jjj 2))
(initget 128)
(setq jj(getpoint (strcat "\n请输入间距:<默认为" (rtos jjj) ">或鼠标框选:")))
(cond ((= (type jj) nil)(setq jj jjj jjj jj hj(+ xc jj) lj(+ yc jj)))
      ((= (type jj) 'STR)(setq jj(read jj) jjj jj hj(+ xc jj) lj(+ yc jj)))
      ((= (type jj) 'list)(setq p1 jj)
                            (initget 1) (setq p2(getcorner p1 "指定对角点:"))
                          (setq lj(abs(- (car p2) (car p1)))
                                hj(abs(- (cadr p2) (cadr p1))))
        )
                               
)
(command "undo" "be")
(command "array" en "" "r"hsls hj lj)
(command "undo" "e")
(princ)
)
;;;子程序，求选集是大外形坐标
(defun Min_Max()
(vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
      maxp (vlax-safearray->list maxp))
(setq minx (car minp)
      maxx (car maxp)
      miny (cadr minp)
      maxy (cadr maxp))
(if (> minx0 minx) (setq minx0 minx))
(if (> miny0 miny) (setq miny0 miny))
(if (< maxx0 maxx) (setq maxx0 maxx))
(if (< maxy0 maxy) (setq maxy0 maxy))
)

Andyhon 发表于 2011-7-2 16:52:21

依您所述,应可 多重Copy 即可
可否上个图纸以方便理解您所谓的
...对象-输入步距
及所要达成的效果

raimo 发表于 2011-7-3 08:12:48

期待继续改进...现在只能矩形阵列,啥时候出环形的?

pb.v@163.com 发表于 2011-7-3 09:57:31

回复 Andyhon 的帖子

这个是瞎摸改成了只有输入列数和列距，原图元可变色，但是不知道怎么变阵列出来的图元变色，谢谢元老指点
;;简易矩形阵列
(defun C:parr()
(vl-load-com)
(setvar "cmdecho" 0)
(command "ucs" "w")
(princ "\n请选择要阵列的物体:")
(while(null(setq en (ssget))))
(setq minx0 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
(setq i 0)
(repeat (sslength en)
   (setq end (ssname en i))
   (setq end_data (entget end))
   (Min_Max)
   (setq i(1+ i))
)
(setq pmin (list minx0 miny0)
      pmax (list maxx0 maxy0))
(setq yc (- maxx0 minx0) xc (- maxy0 miny0))
(if (not hs)(setq hhs 10)(setq hhs (fix hs)))
(if (not ls)(setq lls 10)(setq lls (fix ls)))
(initget 6)(setq hs(getint (strcat "\n请输入步距:<" (itoa hhs) ">")))
(if (not hs)(setq hs hhs))
(initget 6)(setq ls(getint (strcat "\n请输入工站数:<" (itoa lls) ">")))
(if (not ls)(setq ls lls))
(command "undo" "be")
(command "array" en "" "r""1"ls hs)
(command "change" en "" "p" "c" 2 "")
(command "undo" "e")
(princ)
)
;;;子程序，求选集是大外形坐标
(defun Min_Max()
(vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
      maxp (vlax-safearray->list maxp))
(setq minx (car minp)
      maxx (car maxp)
      miny (cadr minp)
      maxy (cadr maxp))
(if (> minx0 minx) (setq minx0 minx))
(if (> miny0 miny) (setq miny0 miny))
(if (< maxx0 maxx) (setq maxx0 maxx))
(if (< maxy0 maxy) (setq maxy0 maxy))
)

Andyhon 发表于 2011-7-3 10:23:46

(command "array" en "" "r""1"ls hs)
(command "change" en "" "p" "c" 2 "")
试试上下列对换

pb.v@163.com 发表于 2011-7-3 11:04:08

回复 Andyhon 的帖子

对换的结果是全部变为2号色，不过我没对换，我是复制了上去，正好，把原图和阵列后的图都变成我想要的颜色，呵，谢谢，此问题就此解决啦
页: [1] 2
查看完整版本: [原创]阵列改进版