同位置复制

韩飞翔

同位置复制，功能虽然简易，但是有时候还真需要这个功能；需要时就很方便；有需要自行下载

llsheng_73

由于不想计算其它图形与参考图形之间的缩放和旋转量，因此只做以块参照为例，进行了比较偷懒的处理方法，导致使用场景受限，偷懒的办法是把要复制的东西做到一个无名图块，以选定的参考对象（块参照）的基点、插入点，比例，旋转等对新做的图块内的对象通过平移，缩放和旋转进行纠正（由于处理方法过于简单，参考对象必须XY比例一致），然后对所选的每一个要放置东西的图块插入点位置按相应的比例和旋转角插入图块

1. (vl-load-com)
   
2. (defun l2array(l / A)
   
3.       (vlax-safearray-fill(vlax-make-safearray 9(cons 0(1-(length l))))
   
4.   (mapcar(function(lambda(x / a)(setq a(type x))(cond((='ename a)(vlax-ename->vla-object x))((='VLA-OBJECT a)x))))l)))
   
5. (defun c:tt(/ *doc *model *blocks blk blkname s1 s e p Origin ang bl o)
   
6.   (setq *doc(vlax-get-property(vlax-get-acad-object)'activedocument)
   
7.   *model(vlax-get-property *doc 'modelspace)
   
8.   *blocks(vlax-get-property *doc'blocks))
   
9.   (while(and(or(PROMPT"\n选选择要复制的图元对象")(setq s1(ssget)))
   
10.       (or(PROMPT"\n选择参考图元对象(参照块)")(setq e(ssget":E:S"'((0 . "insert")))))
    
11.       (setq e(vlax-ename->vla-object(ssname e 0)))
    
12.       (or(PROMPT"\n选择要放置的位置(与参考对象同名块)")
    
13.          (setq blkm(vlax-get-property e'name) s(ssget(list'(0 . "insert")(cons 2 blkm))))))
    
14.     (setq p1(vlax-safearray->list(vlax-variant-value(vlax-get-property e'InsertionPoint)))
    
15.     s1(vl-remove-if'listp(mapcar'cadr(ssnamex s1)))
    
16.     p(apply'mapcar(cons'list(apply'append(mapcar'(lambda(x / a b)
    
17.                (vlax-invoke-method(vlax-ename->vla-object x)'getboundingbox'a 'b)
    
18.                (list(vlax-safearray->list a)(vlax-safearray->list b)))s1))))
    
19.     p(mapcar'+'(0 0)(car(vl-sort(mapcar(function(lambda(y)(mapcar'(lambda(x)(apply y x))p)))'(min max))
    
20.               '(lambda(x y)(>(distance p1 x)(distance p1 y))))))
    
21.     Origin(vlax-get-property(vlax-invoke-method *blocks'item blkm)'Origin)
    
22.     blk(vlax-invoke-method *blocks'add Origin"*U")
    
23.     blkname(vlax-get-property blk'name)
    
24.     ang(-(+ pi pi)(vlax-get-property e'Rotation))
    
25.     bl(/ 1(vlax-get-property e 'XScaleFactor)))
    
26.     (vlax-invoke-method *doc'copyobjects(l2array s1)blk)
    
27.     (vlax-for x blk
    
28.       (vlax-invoke-method x 'move(vlax-3d-point p1)Origin)
    
29.       (vlax-invoke-method x 'ScaleEntity Origin bl)
    
30.       (vlax-invoke-method x 'rotate Origin ang))
    
31.     (vlax-for x (vlax-get-property *doc'ActiveSelectionSet)
    
32.       (setq o(vlax-invoke-method *model'InsertBlock
    
33.          (vlax-get-property x 'InsertionPoint)
    
34.          blkname
    
35.          (vlax-get-property x'XScaleFactor)
    
36.          (vlax-get-property x'YScaleFactor)
    
37.          (vlax-get-property x'ZScaleFactor)
    
38.          (vlax-get-property x'Rotation)))
    
39.       (or(not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(list o 'exlpode))))
    
40.    (vlax-invoke-method o 'delete))
    
41.       )
    
42.     (VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(list blk 'exlpode)))
    
43.     )
    
44. )

(vl-load-com)<br /> (defun l2array(l / A)<br />       (vlax-safearray-fill(vlax-make-safearray 9(cons 0(1-(length l))))<br />   (mapcar(function(lambda(x / a)(setq a(type x))(cond((='ename a)(vlax-ename->vla-object x))((='VLA-OBJECT a)x))))l)))<br /> (defun c:tt(/ *doc *model *blocks blk blkname s1 s e p Origin ang bl o)<br />   (setq *doc(vlax-get-property(vlax-get-acad-object)'activedocument)<br />   *model(vlax-get-property *doc 'modelspace)<br />   *blocks(vlax-get-property *doc'blocks))<br />   (while(and(or(PROMPT"\n选选择要复制的图元对象")(setq s1(ssget)))<br />       (or(PROMPT"\n选择参考图元对象(参照块)")(setq e(ssget":E:S"'((0 . "insert")))))<br />       (setq e(vlax-ename->vla-object(ssname e 0)))<br />       (or(PROMPT"\n选择要放置的位置(与参考对象同名块)")<br />          (setq blkm(vlax-get-property e'name) s(ssget(list'(0 . "insert")(cons 2 blkm))))))<br />     (setq p1(vlax-safearray->list(vlax-variant-value(vlax-get-property e'InsertionPoint)))<br />     s1(vl-remove-if'listp(mapcar'cadr(ssnamex s1)))<br />     p(apply'mapcar(cons'list(apply'append(mapcar'(lambda(x / a b)<br />                (vlax-invoke-method(vlax-ename->vla-object x)'getboundingbox'a 'b)<br />                (list(vlax-safearray->list a)(vlax-safearray->list b)))s1))))<br />     p(mapcar'+'(0 0)(car(vl-sort(mapcar(function(lambda(y)(mapcar'(lambda(x)(apply y x))p)))'(min max))<br />               '(lambda(x y)(>(distance p1 x)(distance p1 y))))))<br />     Origin(vlax-get-property(vlax-invoke-method *blocks'item blkm)'Origin)<br />     blk(vlax-invoke-method *blocks'add Origin"*U")<br />     blkname(vlax-get-property blk'name)<br />     ang(-(+ pi pi)(vlax-get-property e'Rotation))<br />     bl(/ 1(vlax-get-property e 'XScaleFactor)))<br />     (vlax-invoke-method *doc'copyobjects(l2array s1)blk)<br />     (vlax-for x blk<br />       (vlax-invoke-method x 'move(vlax-3d-point p1)Origin)<br />       (vlax-invoke-method x 'ScaleEntity Origin bl)<br />       (vlax-invoke-method x 'rotate Origin ang))<br />     (vlax-for x (vlax-get-property *doc'ActiveSelectionSet)<br />       (setq o(vlax-invoke-method *model'InsertBlock<br />          (vlax-get-property x 'InsertionPoint)<br />          blkname<br />          (vlax-get-property x'XScaleFactor)<br />          (vlax-get-property x'YScaleFactor)<br />          (vlax-get-property x'ZScaleFactor)<br />          (vlax-get-property x'Rotation)))<br />       (or(not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(list o 'exlpode))))<br />    (vlax-invoke-method o 'delete))<br />       )<br />     (VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(list blk 'exlpode)))<br />     )<br /> )

llsheng_73

多段线的话一条线封闭的可以，哪怕经过了旋转，但和参考对象之间，它们的起点和节点顺序是一样的，可以把起点当成块参照的插入点来看待，从参考对象众多节点里边找一个到起点最远的点作为它的基准方向，以距离作为参考比例，往其它线里边放的时候，根据同样的两个点的方向和距离进行方向改正和缩放处理，实际上可以通过transfromby来完成，如果对变换矩阵熟悉的话，不熟悉也可以搞定，只是麻烦些

zhwc125

有意思，谢谢分享！

tigcat

这个程序挺好的。

qifeifei

太厉害了 下载研究看看

advksf

好程序，谢谢分享~

cj52000

谢谢，很好用，就是如果这个相同的图元旋转角度的话就不适用了，如果能支持旋转图形就更完美了

mokson

同位置复制，我用的是这个：

(command "copy" (ssget) "" "@" "@")

mojianxing

很好用不过功能单一了点

sachindkini

Thanks for Sharing

伊偭

谢谢分享！实用