| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как сделать прямоугольник из отрезка?

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

Ответ
Поиск в этой теме
Непрочитано 13.02.2014, 17:55
Как сделать прямоугольник из отрезка?
Омская птица
 
Регистрация: 20.03.2012
Сообщений: 796

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

Вложения
Тип файла: dwg
DWG 2007
Чертеж2.dwg (91.3 Кб, 1239 просмотров)

Просмотров: 5468
 
Непрочитано 12.04.2021, 16:51
#21
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,818
<phrase 1=


Цитата:
Сообщение от 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\" для выполнения ::")
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...

Последний раз редактировалось Alan, 12.04.2021 в 17:43.
Alan вне форума  
 
Непрочитано 12.04.2021, 17:28
#22
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,069


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.04.2021, 17:41
#23
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,818
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Выделение (да и вообще любое форматирование) внутри Lisp-кода здесь не работает.
Привет. А в предпросмотре работало. Сейчас подправлю
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Непрочитано 13.04.2021, 08:18
#24
aafeoktistov


 
Регистрация: 26.02.2019
Сообщений: 41


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

----- добавлено через ~1 мин. -----
Еще есть такой момент, при выполнении лиспа почему то сбрасываются все настроенные привязки... Этого можно как то избежать?
aafeoktistov вне форума  
 
Непрочитано 13.04.2021, 11:17
#25
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,818
<phrase 1=


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Возможно я не совсем правильно описал задачу.
Да, с этим у тебя наверное проблема
Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Но вот конечные прямоугольники из них надо повернуть строго на 90 если конечно линия уже не горизонтальная.
Я вроде так и сделал.
Нарисуй несколько (3-4) линий, построй вручную прямоугольники и приложи к посту.
Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
при выполнении лиспа почему то сбрасываются все настроенные привязки...
Этого НЕ должно быть! Перед построением я запоминаю объектные привязки и после построений возвращаю назад.
Запомнил:
(setq osmd (getvar "osmode"))
Вернул:
(setvar "osmode" osmd)
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...

Последний раз редактировалось Alan, 13.04.2021 в 11:24.
Alan вне форума  
 
Непрочитано 13.04.2021, 11:30
#26
aafeoktistov


 
Регистрация: 26.02.2019
Сообщений: 41


Цитата:
Сообщение от Alan Посмотреть сообщение
Да, с этим у тебя наверное проблема

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

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

П.С. привязки больше не сбрасывает вроде
Вложения
Тип файла: dwg
DWG 2013
пример работы Nz_Restang.dwg (973.7 Кб, 6 просмотров)
aafeoktistov вне форума  
 
Непрочитано 13.04.2021, 21:25
#27
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,818
<phrase 1=


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Прикладываю файл.
Чертеж, который прислал, использовал как постановку задачи. В нём куча мусора, много слоёв и примитивов, на выключенных слоях, сумашедшие координаты и т.д.. Не стал чистить и т.п.
На новом чертеже вычертил 4 отрезка (они красного цвета). Применил программку. Результат прикладываю
Вложения
Тип файла: dwg
DWG 2010
На форум_Restang.dwg (87.0 Кб, 3 просмотров)
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Непрочитано 13.04.2021, 23:14
#28
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,069


Цитата:
Сообщение от 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 обойтись Но показывать решение сейчас мне лениво.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.04.2021, 09:25
#29
aafeoktistov


 
Регистрация: 26.02.2019
Сообщений: 41


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

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

Последний раз редактировалось aafeoktistov, 14.04.2021 в 12:38.
aafeoktistov вне форума  
 
Непрочитано 14.04.2021, 14:08
#30
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,818
<phrase 1=


Цитата:
Сообщение от Кулик Алексей 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\" для выполнения ::")
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...

Последний раз редактировалось Alan, 14.04.2021 в 18:13.
Alan вне форума  
 
Непрочитано 15.04.2021, 08:48
#31
aafeoktistov


 
Регистрация: 26.02.2019
Сообщений: 41


Большое Вам человеческое спасибо!)
aafeoktistov вне форума  
 
Непрочитано 15.04.2021, 19:40
#32
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,818
<phrase 1=


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Можете скинуть Ваш лисп?
Конечно так красиво ка Алексей я не напишу. Но по его примеру я избавился от командных методов.
А также добавил, что повернутый прямоугольник всегда рисуется от нижнего конца отрезка вправо. См.картинку.
Если надо могу дать откорректированный ЛИСП. Или предыдущее решение устраивает?
Миниатюры
Нажмите на изображение для увеличения
Название: пример работы Nz_Restang.png
Просмотров: 14
Размер:	22.4 Кб
ID:	236316  
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...

Последний раз редактировалось Alan, 15.04.2021 в 19:46.
Alan вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как сделать прямоугольник из отрезка?

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как сделать узел вращения? 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