[原创]阵列改进版

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"  hs  ls 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号色，不过我没对换，我是复制了上去，正好，把原图和阵列后的图都变成我想要的颜色

，呵，谢谢，此问题就此解决啦

账号		自动登录	找回密码
密码			注册

[原创]阵列改进版

本帖子中包含更多资源