AutoLisp尝试将所有多段线RECTANGLE移动到特定点.有什么想法吗

Question

所以我有这个代码：

(setq ss (ssget "X" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1) )))
;Selecteaza toate Polyline-urile cu 4 colturi, si care sunt inchise.
(setq n 0
var (getpoint "Select where to order rentagles")
)
(repeat  (sslength ss) ;Parcurge setul de selectie
(setq tent (entget (ssname ss n))
telem (assoc 10 tent)
listvar(cons 10 var))
(setq
tent(subst listvar telem tent)
)
(entmod tent)
(setq n (1+ n))
)
(princ)
)

尽管它是这样做的，但它只将任何矩形的左上角移动到我指定的点。如何对整个矩形执行相同操作，或者如何使用dxf代码更改其他角点？提前感谢！

编辑：我读过"10个顶点坐标(在OCS中(，多个条目；每个顶点一个条目DXF：X值；APP：2D点"如何使用顶点的其他条目？

Answer 1

您需要计算要对齐的顶点和目标点之间的矢量，然后用同一矢量平移所有顶点。

例如(使用其他问题中的代码(：

(defun c:moverect ( / a b c d e i p s v x )
(cond
(   (not (setq s (ssget "_X" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1)))))
(princ "nNo closed polylines found.")
)
(   (setq p (getpoint "nSpecify target point: "))
(setq p (trans p 1 (trans '(0 0 1) 1 0 t)))
(repeat (setq i (sslength s))
(setq i (1- i)
e (ssname s i)
x (entget e)
)
(mapcar 'set '(a b c d) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) x)))
(if
(and
(equal (distance a b) (distance c d) 1e-8)
(equal (distance b c) (distance a d) 1e-8)
(equal (distance a c) (distance b d) 1e-8)
)
(progn
(setq v (mapcar '- p a))
(entmod
(mapcar
'(lambda ( x )
(if (= 10 (car x))
(cons 10 (mapcar '+ (cdr x) v))
x
)
)
x
)
)
)
)
)
)
)
(princ)
)

但是，请注意，与目标点对齐的顶点将取决于二维多段线的方向-您可能希望包括一个测试，以始终选择要对齐的左下顶点-然后您需要决定如何处理旋转的矩形。