tigcat 发表于 2020-11-6 09:37:25

【求助】轴线交点批量缩放图块

本帖最后由 tigcat 于 2021-8-3 14:35 编辑

请问大侠，轴网交点处布置有图块，有没有办法按轴线交点批量缩放图块呢？



taoyi0727 发表于 2020-11-6 09:37:26

(defun c:tt (/ a b end-n n name obj ojb-lst p pt pt-lst scale ss1 ss2)
        (if (and
                                (princ "\n选择块")
                                (setq ss1 (ssget '((0 . "INSERT"))))
                                (princ "\n选择轴线")
                                (setq ss2 (ssget '((0 . "LINE"))))
                                (setq scale (getreal "\n缩放倍数"))
                        )
                (progn
                        (while (setq name (ssname ss2 0))
                                (setq ojb-lst (append ojb-lst (list (vlax-ename->vla-object name))))
                                (ssdel name ss2)
                        )
                        (setq pt-lst nil)
                        (repeat (length ojb-lst)
                                (setq obj (car ojb-lst))
                                (setq ojb-lst (cdr ojb-lst))
                                (foreach x ojb-lst
                                        (if (setq pt (vlax-invoke obj 'Intersectwith x 0))
                                                (setq pt-lst (append pt-lst (list pt)))
                                        )
                                )
                        )
                        (while (setq name (ssname ss1 0))
                                (setq obj (vlax-ename->vla-object name))
                                (setq p t)
                                (setq end-n (length pt-lst))
                                (setq n 0)
                                (while p
                                        (if (= end-n (1+ n)) (setq p nil))
                                        (setq pt (nth n pt-lst))
                                        (vla-GetBoundingBox obj 'a 'b)
                                        (setq a (vlax-safearray->list a));左下角
                                        (setq b (vlax-safearray->list b));右上角
                                        (if (and
                                                                (< (car pt) (car b))
                                                                (> (car pt) (car a))
                                                                (< (cadr pt) (cadr b))
                                                                (> (cadr pt) (cadr a))
                                                        )
                                                (progn
                                                        (vla-ScaleEntity obj (vlax-3D-point pt) scale)
                                                        (setq p nil)
                                                )
                                        )
                                        (setq n (1+ n))
                                )
                                (ssdel name ss1)
                        )
                )
        )
)

tigcat 发表于 2020-11-6 09:38:27

请大侠提供帮助，虽然明经币比较小。

tigcat 发表于 2020-11-8 18:57:38

谢谢大神回复，等下我去电脑上试试，太感谢了。

tigcat 发表于 2020-11-8 19:20:26

taoyi0727 发表于 2020-11-6 09:37
(defun c:tt (/ a b end-n n name obj ojb-lst p pt pt-lst scale ss1 ss2)
        (if (and
                                (princ "\n选 ...

特别感动，也非常感谢，看到发帖时间都是深夜了，大侠这个程序比我想的细致，可以自己输入放大倍数，我试用了一下，速度也很快，我的图块秒杀完成缩放。论坛现在感觉大家不怎么回答问题，我觉得像我这种问题可能没有深度，高手觉得伸手党吧。自己现在的情况是用到的时候去想办法拼凑和改，一旦没有类似的原型，我就不会弄了，由于大多的时候是在改前辈的程序适用自己，没有系统学习下来，所以自己水平低。以后自己多学习，争取提出的问题有水平点。再次感谢@taoyi0727大侠出手相助。

彳余 发表于 2020-12-22 07:47:50

同是结构佬

tigcat 发表于 2020-12-22 10:19:07

彳余 发表于 2020-12-22 07:47
同是结构佬

是的
页: [1]
查看完整版本: 【求助】轴线交点批量缩放图块