同位置复制

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 /> )

cj52000

llsheng_73 发表于 2025-8-3 10:29
楼主放个测试图吧，看看能不能同时满足缩放和旋转

啊， 这个好，这个好，使用场景又丰富了

caoyin

看了 llsheng_73 的演示图，使用体验应该更好。

我的是使用矩阵变换，不支持不等比例缩放

llsheng_73

cj52000 发表于 2025-8-3 11:35
啊， 这个好，这个好，使用场景又丰富了

http://bbs.mjtd.com/forum.php?mo ... &fromuid=202795
用的块搞出来了

llsheng_73

caoyin 发表于 2025-8-4 04:29
看了 llsheng_73 的演示图，使用体验应该更好。

我的是使用矩阵变换，不支持不等比例缩放

正好下载这个来好好学习，高飞鸟论矩阵很详细，但一直没认真学习，吃透了矩阵变换的话，很多地方很简单的样子