lidaxiu 发表于 2024-3-4 18:29:26

能不能批量实现，按单独各自垂线移动物体


能不能批量实理，先以叉字交点画白线的垂线，然后把叉交点和三角形看成整体全部移动到垂点上去

bonny 发表于 2024-3-4 18:29:27

(defun c:tt (/ a b d e i p pp pt s)
        (if (and (setq e (car (entsel "\n选白线：")))
                          (setq s (ssget '((0 . "POINT"))))
                                (setq i -1)
                        )
                (while (setq a (ssname s (setq i (1+ i))))
                        (setq p (cdr (assoc 10 (entget a))))
                        (setq pt (vlax-curve-getClosestPointTo e p t))
                        (setq d (* 3. (distance p pt)))
                        (setq pp
                                (list (polar p (* pi 1.25 ) d)
                                        (polar p (* pi 1.75 ) d)
                                        (polar p (* pi 0.25 ) d)
                                        (polar p (* pi 0.75 ) d)
                                        (polar p (* pi 1.25 ) d)
                                )
                        )
                        (if (setq b (ssget "CP" pp '((0 . "LWPOLYLINE")(90 . 3)(8 . "图层3"))))
                                (command "MOVE" b "" "non" p "non" pt)
                        )
                        (command "MOVE" a "" "non" p "non" pt)
                )
        )
)

lidaxiu 发表于 2024-3-4 18:31:19

本帖最后由 lidaxiu 于 2024-3-4 18:50 编辑

大概意思：按白线各自，批量法线移动

lidaxiu 发表于 2024-3-4 18:47:13


lidaxiu 发表于 2024-3-4 19:09:29

神速啊，大神

lidaxiu 发表于 2024-3-5 11:21:22

bonny 发表于 2024-3-4 18:29



大师，还有点问题，能否帮忙看下，图形中画圈的三角形并未跟随移动，就是说有的图形未动

ssyfeng 发表于 2024-3-5 18:11:57

这个应该跟ssget函数选择有关，像素会影响选择，可以试试加zoom命令缩放视口再选择

lidaxiu 发表于 2024-3-5 18:49:37


(defun c:tt (/ a b d e i p pp pt s)
        (if (and (setq e (car (entsel "\n选白线：")))
                                (setq s (ssget '((0 . "POINT"))))
                                (setq i -1)
                        )
                (progn
                        (setvar "CMDECHO" 0)
                        (while (setq a (ssname s (setq i (1+ i))))
                                (setq p (cdr (assoc 10 (entget a))))
                                (setq pt (vlax-curve-getClosestPointTo e p t))
                                (setq d 0.5);距离改这个值
                                (setq pp
                                        (list (polar p (* pi 1.25 ) d)
                                                (polar p (* pi 1.75 ) d)
                                                (polar p (* pi 0.25 ) d)
                                                (polar p (* pi 0.75 ) d)
                                                (polar p (* pi 1.25 ) d)
                                        )
                                )
                                (if (setq b (ssget "CP" pp '((0 . "LWPOLYLINE")(90 . 3)(8 . "图层3"))))
                                        (command "MOVE" b "" "non" p "non" pt)
                                )
                                (command "MOVE" a "" "non" p "non" pt)
                        )
                        (setvar "CMDECHO" 1)
                )               
        )
)

lidaxiu 发表于 2024-3-5 18:50:53

lidaxiu 发表于 2024-3-5 18:49
(defun c:tt (/ a b d e i p pp pt s)
        (if (and (setq e (car (entsel "\n选白线：")))
                                (setq s ( ...

把波总最终程序贴上来了
页: [1]
查看完整版本: 能不能批量实现，按单独各自垂线移动物体