图形净距离阵列

孙玉坤 · 发表于 2017-10-15 18:36

本帖最后由孙玉坤于 2017-10-15 20:32 编辑

;角度阵列程序（Angle array routine）,比AutoCAD的阵列容易得多。

(defun C:AAR ( / ss ang bp cnt dist d)
(PRINC "\n 角度阵列\(2005.8.5胡晓航\) ")
  (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)
)
这个代码只能做到阵列距离一效果，  哪位大神帮忙改一下  ，如图形二所示，阵列的距离为两个图元间的净距离，加记忆功能。。。

万分感谢

琴剑江山_10184 · 发表于 2017-10-18 11:18

(defun C:aa (/ A1 A2 ANG BP CNT D DIST SS)
(defun ax:GetBoundingBox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
(PRINC "\n 角度阵列\(2005.8.5胡晓航\) ")
(cond
((setq ss (car (entsel "\n选择对象:")))
(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对象个数： "))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (1- cnt)
(setq a1 (ax:GetBoundingBox ss))
(setq a2 (list (caadr a1) (cadar a1)))
(setq d (distance (car a1) a2))
(setq d (+ d dist))
(command "_.copy" ss "" bp (polar bp ang d))
(setq ss (entlast))
)
)
)
(setvar "osmode" 15359)
(princ)
)

(defun C:aa (/ A1 A2 ANG BP CNT D DIST SS) 
  (defun ax:GetBoundingBox (ent / ll ur) 
    (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur) 
    (mapcar 'vlax-safearray->list (list ll ur)) 
) 
  (PRINC "\n 角度阵列\(2005.8.5胡晓航\) ")   
  (cond 
    ((setq ss (car (entsel "\n选择对象:"))) 
     (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对象个数： ")) 
     (setvar "cmdecho" 0) 
     (setvar "osmode" 0) 
     (repeat (1- cnt) 
       (setq a1 (ax:GetBoundingBox ss)) 
       (setq a2 (list (caadr a1) (cadar a1))) 
       (setq d (distance (car a1) a2)) 
       (setq d (+ d dist)) 
       (command "_.copy" ss "" bp (polar bp ang d)) 
       (setq ss (entlast)) 
     )      
    ) 
  ) 
  (setvar "osmode" 15359) 
  (princ) 
)

;注意只考滤陈列间距二水平的效果

xyp1964 · 发表于 2019-1-5 15:25

(defun c:tt ()
(setq ang (UangLE 1 "" "阵列方向<输入或鼠标直接量取>" ang nil))
(setq dist (Udist 1 "" "间隔<输入或鼠标直接量取>" dist nil))
(setq nn (Uint 7 "" "数量" nn))
(setvar "osmode" 0)
(while (setq ss (ssget))
(setq p1 (xyp-9pt ss 1)
p2 (xyp-9pt ss 3)
dd (distance p1 p2)
i 1
)
(repeat (1- nn)
(setq p3 (polar p1 ang (* (+ dd dist) i))
i (1+ i)
)
(xyp-copyMove ss p1 p3)
)
)
(princ)
)

luyu9635 · 发表于 2017-10-18 21:52

也许这个可以满足你的要求，定的规则是这样的：，可以是接受鼠标和键盘输入且有默认值;如果上次的输入是鼠标框选的，这次是按的空格，则默认为阵列距离;如果上次输入是键盘输入产，这次按了空格，则默认为净距离输入;自动记忆上次的输入值且是双项记忆(在有双项阵列的情况下），如下

逍遥天下 · 发表于 2017-10-15 18:46

无法达到阵列间距二的效果

cnks · 发表于 2017-10-17 16:41

楼主的想法有些情况更符合实际工作

孙玉坤 · 发表于 2017-10-18 21:22

琴剑江山_10184 发表于 2017-10-18 11:18
;注意只考滤陈列间距二水平的效果

非常感谢版主的热情帮助，效果刚刚刚的就是不能框选可能在修改成多选那就完美啦

孙玉坤 · 发表于 2017-10-18 22:19

luyu9635 发表于 2017-10-18 21:52
也许这个可以满足你的要求，定的规则是这样的：，可以是接受鼠标和键盘输入且有默认值;如果上次的输入是鼠 ...

正式我想要的功能，万分感谢两位大师的辛苦付出

依然小小鸟 · 发表于 2017-10-18 22:24

孙玉坤发表于 2017-10-18 22:19
正式我想要的功能，万分感谢两位大师的辛苦付出

楼主 CAD批量插入tiff图片或者pdf参考底图并阵列排版你会吗

天下逍遥 · 发表于 2017-10-19 10:42

好东西，正需要，顶顶顶

水仙的错 · 发表于 2017-10-19 16:49

这个不错的，一直头疼的问题被解决了

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

[源码] 图形净距离阵列

本帖子中包含更多资源

本帖子中包含更多资源