Как сделать прямоугольник из отрезка?

Омская птица · 13.02.2014, 17:55

Есть отрезки, расположенные хаотично. Нужно сделать из них прямоугольник, отрезок это ось симетрии прямоугольника. Неизвестная сторона прямоугольника это имя слоя отрезка.

Alan · 12.04.2021, 16:51

Цитата:

Сообщение от aafeoktistov

А подскажите пожалуйста как сделать еще автоматический поворот получившегося прямоугольника в горизонтальную плоскость если линия от которой он строится вертикальная?

В ЛИСПе можно всё. Возникает конечно вопрос:"Зачем это?" Но не думаю, что это задача поставлена преподом... может кому и для дела.
Достаточно добавить анализ угла между точками начала и конца отрезка - смотри строки 58, 88 и 89. И поворачивать в случае необходимости

Код:

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

 (defun c:nz_restang
		    (/	   i	 oldl  osmd  pi2   pi_2	 rr1   rr2
		     n_l   c_l	 ss    el    p1	   p2	 n_l   angl
		     angl_d list_pt
		    )
    (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of vla-startundomark

  (setq	i    0
	oldl (getvar "CLAYER")
	osmd (getvar "osmode")
;;;  (setvar "CECOLOR" col)
	pi2  (/ pi 2)
	pi_2 (/ pi -2)
;;;  ===========; считывание отрезков в список  ======================
;;;	ss   (ssget "_X"
;;;		    '((0 . "LINE"))
;;;	     ) ;_ конец ssget
	rr1  nil
	rr2  nil
  ) ;_ setq
  (setvar "osmode" 0)
;;; выбор объектов LINE
  (setq ss (ssget '((0 . "LINE"))))

			      ; длина списка
;;;  (princ)
;;;  начало построения прямоугольников
  (if ss
    (progn
      (setq i (sslength ss))
      (prompt (strcat "\nВы выбрали "
		      (itoa i)
		      " примитив"
		      (dl_sp i)
	      ) ;_ конец strcat
      )			      ; prompt &strcat
      (setq i	0
	    n_l	(getint "\n Введите ширину прямоугольника <40>:")
	    n_l	(if n_l
		  n_l
		  40
		) ;_ конец if
      ) ;_ конец setq

;;;      цикл по примитивам
      (while (setq el (ssname ss i)) ; el -   примитив 


	(setq p1    (cdr (assoc 10 (entget el)))
	      p2    (cdr (assoc 11 (entget el)))
;;;	    n_l	 (atoi (cdr (assoc 8 (entget el))))
	      c_l   (cdr (assoc 8 (entget el)))
	      angl  (angle p1 p2)
;;;			      ; преобразование углов из  радианов в градусы
	     angl_d (* 180 (/ angl pi))
	) ;_ конец setq
	(if (eq n_l 0)
	  nil
	  (progn
	    (setq
	      list_pt (list (polar p1 (- angl pi2) (/ n_l 2))
			    (polar p1 (- angl pi_2) (/ n_l 2))
			    (polar p2 (- angl pi_2) (/ n_l 2))
			    (polar p2 (- angl pi2) (/ n_l 2))
		      ) ;_ конец list
	    ) ;_ конец setq
	    (entmake (list '(0 . "LWPOLYLINE")
			   '(100 . "AcDbEntity")
			   '(67 . 0)
			   '(410 . "Model")
			   (cons 8 c_l)
			   '(100 . "AcDbPolyline")
			   (cons 43 0)
;;;			 (cons 62 3)
;;;			      ;- группа цвета, сейчас "по слою", в слое в котором отрезок
			   (cons 90 (length list_pt))
			   (cons 10 (nth 0 list_pt))
			   (cons 10 (nth 1 list_pt))
			   (cons 10 (nth 2 list_pt))
			   (cons 10 (nth 3 list_pt))
			   '(70 . 1) ;closed pline
		     ) ;_ конец list
	    ) ;_ конец entmake
;;; анализ угла между точками начала и конца отрезка
	    (if (or (= angl_d 90.) (= angl_d 270.))
	      (command "_ROTATE" (entlast) "" p1 "-90."))
	  ) ;_ конец progn
	) ;_ конец if

	(setq i (1+ i))
      ) ;_ конец while
    ) ;_ конец progn
    (prompt "\n Не выбраны примитивы типа Line в этом чертеже")
  ) ;_ конец if


  (setvar "osmode" osmd)
;;;  (setvar "CECOLOR" col)
  (setvar "CLAYER" oldl)
  (vla-endundomark adoc)
  (princ)
) ;_ конец defun
;;;--------------------------; функция для окончания слова примитив

(defun dl_sp (i / ii)
			      ; длина списка
  (setq
    ii (strlen (itoa i))
			      ; для определения окончания слова примитив
    ii (atoi (substr (itoa i) ii 1))
  ) ;_ конец setq
			      ;                    (print ii)
  (cond
    ((and (> i 10) (< i 15)) "ов")
    ((= ii 1) "")
    ((and (> ii 1) (< ii 5)) "а")
    ((or (< ii 1) (> ii 4)) "ов")
  )			      ; cond
) ;_ конец defun
(princ "\n:: Type \"nz_restang\" для выполнения ::")

Кулик Алексей aka kpblc · 12.04.2021, 17:28

Выделение (да и вообще любое форматирование) внутри Lisp-кода здесь не работает. Лучше уж номера строк укажи )))

Alan · 12.04.2021, 17:41

Цитата:

Сообщение от Кулик Алексей aka kpblc

Выделение (да и вообще любое форматирование) внутри Lisp-кода здесь не работает.

Привет. А в предпросмотре работало. Сейчас подправлю

aafeoktistov · 13.04.2021, 08:18

Я может чего то не понимаю, но созданный прямоугольник не поворачивается. Возможно я не совсем правильно описал задачу. Суть в том что все линии в моем случае в основном либо под 180 либо под 90 градусов. Но вот конечные прямоугольники из них надо повернуть строго на 90 если конечно линия уже не горизонтальная. Извиняюсь за сумбур, просто не пойму как это решить.

----- добавлено через ~1 мин. -----
Еще есть такой момент, при выполнении лиспа почему то сбрасываются все настроенные привязки... Этого можно как то избежать?

Alan · 13.04.2021, 11:17

Цитата:

Сообщение от aafeoktistov

Возможно я не совсем правильно описал задачу.

Да, с этим у тебя наверное проблема

Цитата:

Сообщение от aafeoktistov

Но вот конечные прямоугольники из них надо повернуть строго на 90 если конечно линия уже не горизонтальная.

Я вроде так и сделал.
Нарисуй несколько (3-4) линий, построй вручную прямоугольники и приложи к посту.

Цитата:

Сообщение от aafeoktistov

при выполнении лиспа почему то сбрасываются все настроенные привязки...

Этого НЕ должно быть! Перед построением я запоминаю объектные привязки и после построений возвращаю назад.
Запомнил:
(setq osmd (getvar "osmode"))
Вернул:
(setvar "osmode" osmd)

aafeoktistov · 13.04.2021, 11:30

Цитата:

Сообщение от Alan

Да, с этим у тебя наверное проблема

Я вроде так и сделал.
Нарисуй несколько (3-4) линий, построй вручную прямоугольники и приложи к посту.

Этого НЕ должно быть! Перед построением я запоминаю объектные привязки и после построений возвращаю назад.
Запомнил:
(setq osmd (getvar "osmode"))
Вернул:
(setvar "osmode" osmd)

Прикладываю файл. Там я начертил синюю линию и применил лисп. Получился прямоугольник, его выделил зеленым. Красным показал как хотелось бы видеть конечный результат.

П.С. привязки больше не сбрасывает вроде

Alan · 13.04.2021, 21:25

Цитата:

Сообщение от aafeoktistov

Прикладываю файл.

Чертеж, который прислал, использовал как постановку задачи. В нём куча мусора, много слоёв и примитивов, на выключенных слоях, сумашедшие координаты и т.д.. Не стал чистить и т.п.
На новом чертеже вычертил 4 отрезка (они красного цвета). Применил программку. Результат прикладываю

Кулик Алексей aka kpblc · 13.04.2021, 23:14

Цитата:

Сообщение от aafeoktistov

Красным показал как хотелось бы видеть конечный результат.

А с какого перепугу результат должен быть повернут? Поворачивай исходные данные, и дальше уже строй что надо. И, Alan, зачем так сложно? Можно же и без таких мучений обойтись

Как вариант (особо не тестировал):

Код:

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

 (vl-load-com)

(defun c:rect-by-line (/ selset width adoc elist start end ang)
  (if (and (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "LINE"))))))))
              'pickset
           ) ;_ end of =
           (= (type (setq width (vl-catch-all-apply
                                  (function (lambda ()
                                              (initget 6)
                                              (cond ((getdist "\nВведите ширину создаваемого прямоугольника <40> : "))
                                                    (t 40.)
                                              ) ;_ end of cond
                                            ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of type
              'real
           ) ;_ end of =
      ) ;_ end of and
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (foreach ent ((lambda (/ tab item)
                           (repeat (setq tab  nil
                                         item (sslength selset)
                                   ) ;_ end setq
                             (setq tab (cons (ssname selset (setq item (1- item))) tab))
                           ) ;_ end of repeat
                         ) ;_ end of lambda
                        )
             (setq elist (entget ent)
                   start (trans (cdr (assoc 10 elist)) 0 1)
                   start (cdr (assoc 10 elist))
                   end   (trans (cdr (assoc 11 elist)) 0 1)
                   end   (cdr (assoc 11 elist))
                   ang   (angle start end)
             ) ;_ end of setq
             (entmakex (vl-remove-if-not
                         (function cdr)
                         (list '(0 . "LWPOLYLINE")
                               '(100 . "AcDbEntity")
                               (assoc 67 elist)
                               (assoc 410 elist)
                               (assoc 8 elist)
                               '(100 . "AcDbPolyline")
                               '(43 . 0)
                               '(90 . 4)
                               (assoc 62 elist)
                               (cons 10 (polar start (- ang (* pi 0.5)) (* width 0.5)))
                               (cons 10 (polar start (+ ang (* pi 0.5)) (* width 0.5)))
                               (cons 10 (polar end (+ ang (* pi 0.5)) (* width 0.5)))
                               (cons 10 (polar end (- ang (* pi 0.5)) (* width 0.5)))
                               '(70 . 1)
                         ) ;_ end of list
                       ) ;_ end of vl-remove-if-not
             ) ;_ end of entmakex
           ) ;_ end of foreach
           (vla-endundomark adoc)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

----- добавлено через ~19 мин. -----
Только сейчас сообразил - можно и без vl-remove-if обойтись

Но показывать решение сейчас мне лениво.

aafeoktistov · 14.04.2021, 09:25

Цитата:

Сообщение от Alan

Чертеж, который прислал, использовал как постановку задачи. В нём куча мусора, много слоёв и примитивов, на выключенных слоях, сумашедшие координаты и т.д.. Не стал чистить и т.п.
На новом чертеже вычертил 4 отрезка (они красного цвета). Применил программку. Результат прикладываю

Я вижу как у Вас получается но у меня почему то с тем же лиспом результат не такой... Можете скинуть Ваш лисп? В любом случае спасибо за помощь.

П.С. На счет поворота это просто попытка решения одной специфической задачи.

Alan · 14.04.2021, 14:08

Цитата:

Сообщение от Кулик Алексей aka kpblc

Alan, зачем так сложно?

Ну у тебя даже ночью ВСЁ просто!!!

А я по стариковски...

----- добавлено через ~57 мин. -----

Цитата:

Сообщение от aafeoktistov

у меня почему то с тем же лиспом результат не такой...

Ты же не показал результат, который получается, а прислал хотелку. Я сразу не разобрался, пришлось Алексея aka kpblc будить,

чтобы он глянул.
У тебя прямоугольник отскакивает вдаль... потому что у тебя назначена ПСК. Если перевести в Мировую (_UCS), то всё работает с моим опубликованным ЛИСПом.
Вариант для ПСК я подправлю и выложу.

P.S. Алексей, извини. Не стал копаться с исправлениями текста, просто добавил пару строк переназначения _UCS , если пользовательская
Подправленный текст:

Код:

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

 (defun c:nz_restang
		    (/	   i	 oldl  osmd  pi2   pi_2	 rr1   rr2
		     n_l   c_l	 ss    el    p1	   p2	 n_l   angl
		     angl_d list_pt
		    )
    (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of vla-startundomark

  (setq	i    0
	oldl (getvar "CLAYER")
	osmd (getvar "osmode")
;;;  (setvar "CECOLOR" col)
	pi2  (/ pi 2)
	pi_2 (/ pi -2)
;;;  ===========; считывание отрезков в список  ======================
;;;	ss   (ssget "_X"
;;;		    '((0 . "LINE"))
;;;	     ) ;_ конец ssget
	rr1  nil
	rr2  nil
  ) ;_ setq
;;;					; если ПСК не мировая
  (if (= (getvar "worlducs") 0)
    (progn
      (setq flag t)
	(command "_UCS" "_W")
    ) ;_ конец progn
  ) ;_ конец if  
(setvar "osmode" 0)
;;; выбор объектов LINE
  (setq ss (ssget '((0 . "LINE"))))

			      ; длина списка
;;;  (princ)
;;;  начало построения прямоугольников
  (if ss
    (progn
      (setq i (sslength ss))
      (prompt (strcat "\nВы выбрали "
		      (itoa i)
		      " примитив"
		      (dl_sp i)
	      ) ;_ конец strcat
      )			      ; prompt &strcat
      (setq i	0
	    n_l	(getreal "\n Введите ширину прямоугольника <40>:")
	    n_l	(if n_l
		  n_l
		  40.
		) ;_ конец if
      ) ;_ конец setq

;;;      цикл по примитивам
      (while (setq el (ssname ss i)) ; el -   примитив 


	(setq p1    (cdr (assoc 10 (entget el)))
	      p2    (cdr (assoc 11 (entget el)))
;;;	      p3 p1
;;;	    n_l	 (atoi (cdr (assoc 8 (entget el))))
	      c_l   (cdr (assoc 8 (entget el)))
	      angl  (angle p1 p2)
;;;			      ; преобразование углов из  радианов в градусы
	      angl_d (* 180 (/ angl pi))
	) ;_ конец setq
	(if (eq n_l 0)
	  nil
	  (progn
	    (setq
	      list_pt (list (polar p1 (- angl pi2) (/ n_l 2))
			    (polar p1 (- angl pi_2) (/ n_l 2))
			    (polar p2 (- angl pi_2) (/ n_l 2))
			    (polar p2 (- angl pi2) (/ n_l 2))
		      ) ;_ конец list
	    ) ;_ конец setq
	    (entmake (list '(0 . "LWPOLYLINE")
			   '(100 . "AcDbEntity")
			   '(67 . 0)
			   '(410 . "Model")
			   (cons 8 c_l)
			   '(100 . "AcDbPolyline")
			   (cons 43 0)
;;;			 (cons 62 3)
;;;			      ;- группа цвета, сейчас "по слою", в слое в котором отрезок
			   (cons 90 (length list_pt))
			   (cons 10 (nth 0 list_pt))
			   (cons 10 (nth 1 list_pt))
			   (cons 10 (nth 2 list_pt))
			   (cons 10 (nth 3 list_pt))
			   '(70 . 1) ;closed pline
		     ) ;_ конец list
	    ) ;_ конец entmake
	    (if	(or (= angl_d 90.) (= angl_d 270.))
	      (command "_ROTATE" (entlast) "" p1 "-90.")
	    ) ;_ конец if
	  ) ;_ конец progn
	) ;_ конец if

	(setq i (1+ i))
      ) ;_ конец while
    ) ;_ конец progn
    (prompt "\n Не выбраны примитивы типа Line в этом чертеже")
  ) ;_ конец if


  (setvar "osmode" osmd)
;;;  (setvar "CECOLOR" col)
  (setvar "CLAYER" oldl)
  ;;;					; если ПСК не мировая
  (if flag
      (command "_UCS" "_P")
  ) ;_ конец if
  
  (vla-endundomark adoc)

  (princ)
) ;_ конец defun
;;;--------------------------; функция для окончания слова примитив

(defun dl_sp (i / ii)
			      ; длина списка
  (setq
    ii (strlen (itoa i))
			      ; для определения окончания слова примитив
    ii (atoi (substr (itoa i) ii 1))
  ) ;_ конец setq
			      ;                    (print ii)
  (cond
    ((and (> i 10) (< i 15)) "ов")
    ((= ii 1) "")
    ((and (> ii 1) (< ii 5)) "а")
    ((or (< ii 1) (> ii 4)) "ов")
  )			      ; cond
) ;_ конец defun
(princ "\n:: Type \"nz_restang\" для выполнения ::")

aafeoktistov · 15.04.2021, 08:48

Большое Вам человеческое спасибо!)

Alan · 15.04.2021, 19:40

Цитата:

Сообщение от aafeoktistov

Можете скинуть Ваш лисп?

Конечно так красиво ка Алексей я не напишу. Но по его примеру я избавился от командных методов.
А также добавил, что повернутый прямоугольник всегда рисуется от нижнего конца отрезка вправо. См.картинку.
Если надо могу дать откорректированный ЛИСП. Или предыдущее решение устраивает?

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как сделать узел вращения?	remenikomer	Машиностроение	28	25.07.2011 11:39
Как сделать курсив GOST Type A (или B) в размерных выносках?	igor_skor	AutoCAD	5	22.01.2011 11:42
Нужно сделать чтобы ISOLINES цилиндра не совпадали с диагоналями прямоугольника	Gepar	AutoCAD	2	09.11.2010 21:15
Как сделать одной из граней SOLID поверхность Polygon mesh	kukuikar	AutoCAD	1	16.05.2007 07:58

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск