Lisp沿z a移动对象

saycaphe · 发表于 2022-7-5 16:09:01

嘿，伙计们！
我需要一个列表，使选定对象沿z轴移动，从基点开始以增量间隔。
每条线的距离为500。
这意味着与基点最近的直线将移动500，下一条将移动1000（2x500），下一条将移动1500（3x500）。
对不起我的英语

Tharwat · 发表于 2022-7-5 16:17:34

你好

试试这个未经测试的程序，告诉我你是怎么做的。


(defun c:Test ( / int inc run org sel ent lst)
 ;;------------------------------------;;
 ;;        Tharwat - Date: 31.Jul.2017        ;;
 ;; Move selected objects on Z axis        ;;
 ;; with intervals of 500 units.        ;;
 ;;------------------------------------;;
 (if (setq int -1 inc 500. run 0. org '(0. 0. 0.) sel (ssget "_:L" '((0 . "~VIEWPORT"))))
   (progn
     (while (setq ent (ssname sel (setq int (1+ int))))
       (setq lst (cons (list (distance org (vlax-curve-getclosestpointto ent org)) ent) lst))
       )
     (foreach obj (vl-sort lst '(lambda (j k) (< (car j) (car k))))
       (vlax-invoke (vlax-ename->vla-object (cadr obj)) 'move org (list 0. 0. (setq run (+ inc run))))
       )
     )
   )
 (princ)
 ) (vl-load-com)

saycaphe · 发表于 2022-7-5 16:22:53

Tharwat，谢谢你的帮助。
只有一个小问题：我们怎么能有一个序列沿着y轴移动平面x0z上的帧，从z轴开始以增量间隔。
我们可以用一条平行于0x的线切割帧吗？从切割点到切割点的距离（从小到大）将按顺序移动
框架。图纸

saycaphe · 发表于 2022-7-5 16:27:03

以及如何沿z轴移动x0y平面上的帧，以及如何沿x轴移动y0z平面上的帧。
谢谢

Tharwat · 发表于 2022-7-5 16:29:23

不客气。

您可以使用以下代码中的轴在任意轴上移动对象。

copy


(list 0.[color="red"] ;; X Axis[/color]
     0. [color="green"];; Y Axis[/color]
    (setq run (+ inc run)) [color="blue"];; Z Axis[/color]
)

saycaphe · 发表于 2022-7-5 16:34:47

对于红色多段线，可以移动。
对于蓝色多段线，移动不是按顺序进行的。
当我将所有颜色更改为红色时，这些多段线也不遵循顺序。
我们如何改变：o

Tharwat · 发表于 2022-7-5 16:40:10

在我之前的回复中，我用颜色强调的代码与该图形中相同颜色的对象无关，但它们是X、Y、Z坐标。

saycaphe · 发表于 2022-7-5 16:42:36

嗨，塔尔瓦特。
红色和蓝色，我指的是多段线的颜色，而不是你突出显示的颜色。
只有要移动的序列，lisp首先移动红色多段线，然后移动蓝色多段线

Roy_043 · 发表于 2022-7-5 16:47:16

问题并不像OP建议的那么简单。某些截面由两条多段线组成。因此，根据它们与单个点的距离对它们进行排序是行不通的。

Roy_043 · 发表于 2022-7-5 16:51:36

另一个问题：
蓝色多段线（实际上是颜色152）绘制在红色多段线的顶部。
在附图中，该问题已得到解决，并添加了一条洋红色线。

以该行作为输入，下面的代码给出了合理的结果。但是属于球根突的部分仍然需要手动移动。

copy

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)
(defun c:Test ( / cur enm inc obj ss sta)
 (setq inc 500.0)
 (setq cur 0.0)
 (setq enm (car (entsel "\nSelect magenta line: ")))
 (setq obj (vlax-ename->vla-object enm))
 (setq ss
   (ssget
     "_F"
     (list
       (trans (setq sta (vlax-get obj 'startpoint)) 0 1)
       (trans (vlax-get obj 'endpoint) 0 1)
     )
     '((0 . "LWPOLYLINE") (-4 . "<OR") (62 . 1) (62 . 152) (-4 . "OR>"))
   )
 )
 (foreach pl
   (mapcar
     'cadr
     (vl-sort
       (mapcar
         '(lambda (pl) (list (distance sta (vlax-invoke obj 'intersectwith pl acextendnone)) pl))
         (KGA_Conv_Pickset_To_ObjectList ss)
       )
       '(lambda (a b) (< (car a) (car b)))
     )
   )
   (vlax-invoke pl 'move '(0.0 0.0 0.0) (list 0.0 (setq cur (+ cur inc)) 0.0))
 )
 (princ)
)

框架2。图纸

[编程交流] Lisp沿z a移动对象

发表回复

精选推荐