[Vict0r]

Уважаемые форумчане!
Часто приходится чертить прямоугольные полилинии (например: внешнюю стену дома с парой пристроек одной фигурой). При этом ясно что все углы по 90 градусов и было бы отлично не рисовать последний сегмент и потом замыкать его с первой вершиной, а чтобы этот последний угол фигуры достраивался автоматом.
В идеале процесс примерно такой:
1. Указать первую и вторую точки первого сегмента полилинии (одна из стен дома)
2. Повернуть оси координат по этим двум точкам
3. "ortomode" 1
4. Начать чертить полилинию: по первой, второй точке, спросить третью и т.д. до тех пор пока не останется нарисовать последний угол, после чего прерывание по пробелу.
5. Автоматическое достраивание последнего угла полилинии.

[Кулик Алексей aka kpblc]

А чем опция "_c" ("_close") не устраивает?

[Vict0r]

она достраивает лишь одну последнюю сторону, а нужно две последних.

[shifr]

Сообщение от Vict0r она достраивает лишь одну последнюю сторону, а нужно две последних.

Регистрация: 30.03.2006

Даже я знаю, что можно построить прямоугольник по 2-м точкам (диагональным).

[sertor]

Может этот лисп устроит?

[Olga_@@@]

Можно еще так:

Команда: _polygon Число сторон <4>: и т.д.

[Vict0r]

Сообщение от shifr Даже я знаю, что можно построить прямоугольник по 2-м точкам (диагональным).

Сообщение от Olga_@@@ Можно еще так: Команда: _polygon Число сторон <4>: и т.д.

Не путайте прямоугольники с прямоугольными фигурами. Также фигура может не быть параллельной осям координат, тогда нужно поворачивать оси (либо фигуру), что можно было бы автоматизировать.

Сообщение от sertor Может этот лисп устроит?

Спасибо, но он тоже для прямоугольников (

[pan]

Напрашивается мультилиния

[sbi]

Сообщение от Vict0r Не путайте прямоугольники с прямоугольными фигурами. Также фигура может не быть параллельной осям координат, тогда нужно поворачивать оси (либо фигуру), что можно было бы автоматизировать.

Итак, у вас прямоугольный тип фигуры (мышечная и жировая ткань практически равномерна распределена по всему телу, то есть образует силуэт «прямоугольника»),а не многоугольник с прямыми углами, который просто строится с помощью lisp или VBA

[Olga_@@@]

Сообщение от Vict0r Также фигура может не быть параллельной осям координат, тогда нужно поворачивать оси (либо фигуру), что можно было бы автоматизировать.

ну, с поворотом как раз никаких проблем

[Vict0r]

Сообщение от sbi просто строится с помощью lisp или VBA

Можете помочь?

[sbi]

Сообщение от Vict0r Можете помочь?

Для этого нужны исходные данные и конечный результат. (алгоритмов много)
Это надо:

[Vict0r]

В приложенном примере:
1. Исходные данные.
2. Процесс построения (указанное красным должно достраиваться автоматом).
3. Результат построения.

[копатыч]

Можно рисовать так:
полилиния по точкам (режим орто ВКЛ)1,2,3,4,5
затем правой кнопкой вызвать контекстное меню->Переопределение привязок->координатные фильтры->(нажать Y или X , и Указать на точку 1),
потом протянуть мышь по дугой оси (X или Y) и ткнуть мышкой не сильно прицеливаясь, нарисуется линия, останется только замкнуть.
МОжно вывести координатные фильтры в панель привязок, и процесс пойдёт быстрее.
Если нужен повёрнутый многоугольник, надо повернуть оси XY вокруг оси Z и нарисовать. Потом вернуть оси на место, команда МСК

[Vict0r]

я знаю как рисовать. я спрашиваю про автоматизацию, а не танцы с бубном.

[Кулик Алексей aka kpblc]

Сообщение от Vict0r я спрашиваю про автоматизацию

Тема перемена в "Программирование"

[VVA]

Тестируйте

Код:

[Выделить все]

(defun C:P90 (/ *error* pt1 pt2 str pt1W pt2W ucs ucf U_M om ss isRus)
;;; Polyline 90 degree
  (defun *error* (msg)
    (princ msg)
    (if ucs
      (command "_.UCS" "_restore" "TmpUsc")
    ) ;_ end of if
    (setvar "UCSFOLLOW" ucf)
    (setvar "ortomode" om)
    (princ)
  ) ;_ end of defun
;;; BETWEENP
;;; Evaluates if pt is between p1 and p2 (or equal to)
;;; Arguments = 3 points
(defun betweenp    (p1 p2 pt)
  (or (equal p1 pt 1e-9)
      (equal p2 pt 1e-9)
      (equal (vec1 p1 pt) (vec1 pt p2) 1e-9)
  )
)
;;; VEC1
;;; Returns the single unit vector from p1 to p2
;;; Arguments = two points
(defun vec1 (p1 p2 / d)
  (if (not (zerop (setq d (distance p1 p2))))
    (mapcar '(lambda (x1 x2) (/ (- x2 x1) d)) p1 p2)
  )
)   
  (setvar "CMDECHO" 0)
  (setq ucf (getvar "UCSFOLLOW")
        om  (getvar "ORTHOMODE")
        isRus (= (getvar "SysCodePage") "ANSI_1251")
  ) ;_ end of setq
  (vl-load-com)
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) (command "_.UNDO" "_All"))
    ((= (logand U_M 3) 3) (command "_.UNDO" "_Control" "_All"))
    (t nil)
  ) ;_ end of cond
  (command "_.UNDO" "_M")
  (setq U_M (getvar "UNDOMARKS"))
  (setvar "UCSFOLLOW" 0)
  (setvar "EXPERT" 5)
  (command "_.UCS" "_save" "TmpUsc")
  (initget 1)
  (setq pt1  (getpoint (if isRus "\nОт точки:" "\nFrom point:"))
        pt1W (trans pt1 1 0)
        ss   (ssadd)
  ) ;_ end of setq
  (setq str (if isRus "\nК точке <выход>:" "\nTo point <exit>: "))
  (while (setq pt2 (getpoint pt1 str))
    (cond
      ((member pt2 '("О" "о" "_u" "_U" "u" "U"))
       (if (< U_M (getvar "UNDOMARKS"))
         (progn
           (command "_.UNDO" "_B")
           (setq pt1W (list (getvar "USERR1") (getvar "USERR2")))
           (setq pt1 (trans pt1W 0 1))
         ) ;_ End of progn
         (progn
           (alert (if isRus "Отменять больше нечего" "nothing more to Undo"))
         ) ;_ End of progn
       ) ;_ End of if
      )
      (t
       (setq
         pt1W (trans pt1 1 0)
         pt2W (trans pt2 1 0)
       ) ;_ end of setq
       (setvar "USERR1" (car pt1W))
       (setvar "USERR2" (cadr pt1W))
       (command "_.UNDO" "_M")
       (setvar "ORTHOMODE" 1)
       (command "_.LINE" "_none" pt1 "_none" pt2 "")
       (ssadd (entlast) ss)
       (setq
         ucs (vl-cmdf "_.UCS"
                      "_N"
                      "_3"
                      "_none"
                      pt1
                      "_none"
                      pt2
                      (polar pt2 (+ (angle pt1 pt2) (* 0.5 pi)) 10)
             ) ;_ end of vl-cmdf
       ) ;_ end of setq
       (setq pt1 (trans pt1W 0 1)
             pt2 (trans pt2W 0 1)
             pt1 pt2
       ) ;_ end of setq
      )
    ) ;_ end of cond
    (setq str (if isRus "\nК точке [Отмена] <замкнуть и выйти>:" "\nTo point [Undo] <close and exit>:"))
    (initget "Отмена Undo _U U")
  ) ;_ End of While
  (setq str
         (vl-remove-if-not
           'entget
           (vl-remove-if
             (function listp)
             (mapcar (function cadr) (ssnamex ss))
           ) ;_ vl-remove-if
         ) ;_ end of vl-remove-if-not
  ) ;_  setq  
  (setq pt1  (entget (car str))
        pt2  (trans (cdr (assoc 11 pt1)) 0 1)
        pt1  (trans (cdr (assoc 10 pt1)) 0 1)
        pt1W (entget (last str))
        pt2W (trans (cdr (assoc 11 pt1W)) 0 1)
        pt1W (trans (cdr (assoc 10 pt1W)) 0 1)
;;;        pt1  (trans pt1 0 1)
;;;        pt2  (trans pt2 0 1)
;;;        pt1W (trans pt1W 0 1)
;;;        pt2W (trans pt2W 0 1)
  ) ;_ end of setq
  (setq STR
         (cond
           (
            (inters PT2W
                    (polar PT2W (angle PT2 PT1) 10)
                    PT1
                    (polar PT1 (angle PT1W PT2W) 10)
                    NIL
                    ) ;_ end of inters
            )
           (t
            (setq U_M
             (inters PT1W
                    PT2W
                    PT1
                    (polar PT1 (+ (angle PT1W PT2W) (* 0.5 pi)) 10)
                    NIL
                    ) ;_ end of inters
                  )
            (if (betweenp PT1W PT2W U_M)
              (inters PT1
                    PT2
                    PT2W
                    (polar PT2W (+ (angle PT1 PT2) (* 0.5 pi)) 10)
                    NIL
                    ) ;_ end of inters
              U_M
              )
            )
           ) ;_ end of cond
        ) ;_ end of setq
  (command "_.LINE"
           "_none"
           pt2W
           "_none"
          str
           ""
  ) ;_ end of command
  (ssadd (entlast) ss)
  (command "_.LINE" "_none" "@" "_none" pt1 "")
  (ssadd (entlast) ss)
  (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
    (vl-cmdf "_pedit" "_Multiple" (ssname ss 0)(ssdel (ssname ss 0) ss) "" "_Join" 0 "")
    (vl-cmdf "_pedit" "_Multiple" (ssname ss 0) (ssdel (ssname ss 0) ss) "" "_Y" "_Join" 0 "")
  ) ;_ end of if
  (if ucs
    (command "_.UCS" "_restore" "TmpUsc")
  ) ;_ end of if
  (setvar "UCSFOLLOW" ucf)
  (setvar "ORTHOMODE" om)
  (princ)
) ;_ end of defun

[roaa]

Недавно выкладывал функцию выбора рамкой под углом. На ее основе:

Код:

[Выделить все]

 
(defun C:poly90 ()
;;; Отрисовка замкнутой прямоугольной полилинии

(defun _sensor_select_frame ( clr illum ang1 / _getosmode _grX _dyn_frame p1 p2 )
;;; Функция выбора рамкой
;;; Аргументы:
;;;   clr - цвет рамки   
;;;   illum - t с подсветкой, nil - без
;;;   ang1 - угол в радианах, если nil предлагает задать
;;; Вызов:
;;;   (_sensor_select_frame 1 nil nil)
;;; Возвращает:
;;;   Список координат точек рамки
  (redraw)
  
  (defun _getosmode ( os / lst )
    (foreach mode
     '(
         (0001 . "_end")
         (0002 . "_mid")
         (0004 . "_cen")
         (0008 . "_nod")
         (0016 . "_qua")
         (0032 . "_int")
         (0064 . "_ins")
         (0128 . "_per")
         (0256 . "_tan")
         (0512 . "_nea")
         (1024 . "_qui")
         (2048 . "_app")
         (4096 . "_ext")
         (8192 . "_par")
      )
      (if (not (zerop (logand (car mode) os)))
        (setq lst (cons "," (cons (cdr mode) lst)))
      )
    )
    (apply 'strcat (cdr lst))
  )  
  
  (defun _grX ( p s c / -s r q )
    (setq -s (- s)
           r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE)))
           p (trans p 1 3)
    )
    (grvecs
      (list c 
            (list -s      -s) (list s        s)
            (list -s (1+ -s)) (list (1- s)   s)
            (list (1+ -s) -s) (list s   (1- s))
            
            (list -s       s) (list s       -s)
            (list -s  (1- s)) (list (1- s)  -s)
            (list (1+ -s)  s) (list s  (1+ -s))
      )
      (list
            (list r  0. 0. (car  p))
            (list 0. r  0. (cadr p))
            (list 0. 0. r  0.)
            (list 0. 0. 0. 1.)
      )
    )
    p
  )
  
  (defun _dyn_frame ( p1 p2 p3 ang1 ang2  clr illum / pd1 pd2 )  
    (setq pd1 (inters p1 (polar p1 ang2 100) p3 (polar p3 ang1 100) nil)
          pd2 (inters p2 (polar p2 ang2 100) p3 (polar p3 ang1 100) nil)
    )
    (grvecs (list (if (eq illum 't) (- clr) clr) p1 p2  p2 pd2  pd2 pd1  pd1 p1))
    (list pd2 pd1)
  )
  
  (defun *error* ( msg )
    (princ "\nЗавершено пользователем.  ")
    (redraw)
  )
    
  (if 
    (and (eq (type clr) 'int)
         (setq p1   (getpoint "\nSpecify Base Point: "))
         (if (not ang1)(setq ang1 (getangle p1 "\nSpecify an Angle: "))(member (type ang1) '(int real)))
         (setq ang2 (+ ang1 (* 0.5 pi)))
    )
    (progn
      (setq os (_getosmode (getvar 'OSMODE)))
      (princ (setq ms "\nSpecify Opposite Corner: "))
      (while 
        (progn
          (and (setq gr (grread t 15 0) g1 (car gr) pd (cadr gr)) (/= g1 3))
          (cond
                (  (= g1 5) (redraw)
                   (if
                     (and
                       (zerop (logand 16384 (getvar 'OSMODE)))
                       (setq op (osnap pd os))
                     )
                     (_grX (setq pd op) 6 20)
                   )
                   (setq p34
                             (_dyn_frame p1 
                               (setq p2 (inters p1 (polar p1 ang1 100) pd (polar pd ang2 100) nil))
                               pd ang1 ang2 clr illum
                             )
                   )
                )
                (  (or (member gr '((2 13) (2 32)))(or (= g1 11) (= g1 25)))
                   (setq p34 nil)
		)
          )
        )
      )
      (redraw)
      (if p34 (cons p1 (cons p2 p34)) nil)
    )
  )
)
  (while (setq lst (_sensor_select_frame 250 nil nil))
    (vl-cmdf "_.pline")
    (foreach pt lst (vl-cmdf "_none" pt)) ;_ end of foreach
    (vl-cmdf "_close")
  ) ;_ end of while
  (princ)
) ;_ end of defun

И никаких UCS.
Цвет рамки и подсветка в аргументах функции.

[sbi]

VVA При нахождении последней точки ниже повернутой ПСК создается срез.

[Vict0r]

VVA, человеческое Вам спасибо, код работает без нареканий. Было бы вообще идеально, если вершиной №1 созданной полилинии была бы первая указанная точка (pt1).
roaa, Ваш код чертит прямоугольный четырехугольник по трем точкам. Точно также как стандартная команда Rectang (с опцией rotate). Но спасибо за внимание к теме.