AutoLisp пытается переместить всю полилинию ПРЯМОУГОЛЬНИК в указанную c точку. Есть предположения? - PullRequest
Новая
       60

AutoLisp пытается переместить всю полилинию ПРЯМОУГОЛЬНИК в указанную c точку. Есть предположения?

0 голосов
/ 05 мая 2020

Итак, у меня есть этот код: 

    (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 точка» Как я могу использовать другую записи вершин?

1 Ответ

0 голосов
/ 05 мая 2020

Вам нужно будет вычислить вектор между вершиной, которую вы sh выровняете, и целевой точкой, а затем преобразовать все вершины по одному и тому же вектору.

Например ( используя код из вашего другого вопроса ): 

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

Однако обратите внимание, что вершина, выровненная с целевой точкой, будет зависеть от направления 2D-полилинии - вы можете включить тест, чтобы всегда выберите, скажем, нижнюю левую вершину для выравнивания - и тогда вам нужно будет решить, как обрабатывать повернутые прямоугольники.

...