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

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

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

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

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

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

Просмотров: 15756
 
Непрочитано 13.02.2014, 19:00
#2
Alan

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


Правильнее наверное эту тему наверное в Программирование...
Без проверки, на вскидку.
Код:
[Выделить все]
 ;;;  ===========; считывание отрезков в список  ======================
      (setq i	 0
	    pi2	 (/ pi 2)
	    pi_2 (/ pi -2)
	    ss	 (ssget	"_X"
			'((0 . "LINE"))
		 ) ;_ конец ssget
      ) ;_ 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))))
      angl (angle p1 p2)
) ;_ конец setq
  (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
(setq e	(entmake (list '(0 . "LWPOLYLINE")
		       '(100 . "AcDbEntity")
		       '(67 . 0)
		       '(410 . "Model")
		       (cons 8 "0")
		       '(100 . "AcDbPolyline")
		       (cons 43 0)
;;;		       (cons 62 1) - группа цвета, сейчас "по слою", в слое "0"
		       (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
) ;_ конец setq
(setq i (1+ i)))
Файл на котором проверял приложил
Вложения
Тип файла: dwg
DWG 2004
Чертеж2.dwg (63.5 Кб, 1173 просмотров)
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...

Последний раз редактировалось Alan, 13.02.2014 в 19:36.
Alan вне форума  
 
Автор темы   Непрочитано 13.02.2014, 22:21
#3
Омская птица


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


Спасибо за труд! Скажите пожалуйста как сие загрузить? Сделал _appload, а как вызвать?
Омская птица вне форума  
 
Непрочитано 14.02.2014, 00:02
#4
Кулик Алексей aka kpblc
Moderator

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


http://dwg.ru/pub/9
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.02.2014, 01:10
#5
Alan

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


Цитата:
Сообщение от Омская птица Посмотреть сообщение
Сделал _appload, а как вызвать?
Я не оформлял это программой/командой. После загрузки текста выполняется построение прямоугольников по отрезкам.
Оформить командой?
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Автор темы   Непрочитано 14.02.2014, 09:38
#6
Омская птица


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


Цитата:
Сообщение от Alan Посмотреть сообщение
После загрузки текста выполняется построение прямоугольников по отрезкам
Копирую в командную строку и получается вот что:
Код:
[Выделить все]
Выберите объекты:

                  ОТРЕЗОК            Слой: "250"
                                     Пространство: Пространство модели
Масштаб типа линий =     100.0
                   Метка = 2a7
                от точки, X=  38586.6  Y=  21497.5  Z=      0.0
                до точки, X=  37629.5  Y=  21497.5  Z=      0.0
          Длина =    957.1, Угол в плоскости XY =    180
                  Дельта X =      -957.1, Дельта Y =         0.0, Дельта Z =    
     0.0

                  ОТРЕЗОК            Слой: "250"
                                     Пространство: Пространство модели
Масштаб типа линий =     100.0
                   Метка = 2a6
                от точки, X=  38223.7  Y=  21057.7  Z=      0.0
                до точки, X=  38586.6  Y=  21497.5  Z=      0.0
          Длина =    570.2, Угол в плоскости XY =     50
                  Дельта X =       362.9, Дельта Y =       439.8, Дельта Z =    
     0.0

                  ОТРЕЗОК            Слой: "250"
                                     Пространство: Пространство модели
Нажмите ENTER для продолжения:
Масштаб типа линий =     100.0
                   Метка = 2a5
                от точки, X=  38862.8  Y=  20768.8  Z=      0.0
                до точки, X=  38223.7  Y=  21057.7  Z=      0.0
          Длина =    701.4, Угол в плоскости XY =    156
                  Дельта X =      -639.2, Дельта Y =       288.9, Дельта Z =    
     0.0

                  ОТРЕЗОК            Слой: "250"
                                     Пространство: Пространство модели
Масштаб типа линий =     100.0
                   Метка = 2a4
                от точки, X=  39331.7  Y=  21529.6  Z=      0.0
                до точки, X=  38862.8  Y=  20768.8  Z=      0.0
          Длина =    893.8, Угол в плоскости XY =    238
                  Дельта X =      -468.9, Дельта Y =      -760.9, Дельта Z =    
     0.0

                  ОТРЕЗОК            Слой: "300"
                                     Пространство: Пространство модели
Масштаб типа линий =     100.0
                   Метка = 2a3
                от точки, X=  38827.5  Y=  22210.2  Z=      0.0
                до точки, X=  39331.7  Y=  21529.6  Z=      0.0
          Длина =    847.0, Угол в плоскости XY =    307
                  Дельта X =       504.3, Дельта Y =      -680.6, Дельта Z =    
     0.0

                  ОТРЕЗОК            Слой: "100"
                                     Пространство: Пространство модели
Масштаб типа линий =     100.0
                   Метка = 2a2
                от точки, X=  37912.1  Y=  21433.3  Z=      0.0
                до точки, X=  38827.5  Y=  22210.2  Z=      0.0
          Длина =   1200.6, Угол в плоскости XY =     40
                  Дельта X =       915.4, Дельта Y =       776.9, Дельта Z =    
     0.0

                  ОТРЕЗОК            Слой: "250"
                                     Пространство: Пространство модели
Масштаб типа линий =     100.0
                   Метка = 241
                от точки, X=  37259.8  Y=  20856.2  Z=      0.0
                до точки, X=  37259.8  Y=  22635.8  Z=      0.0
          Длина =   1779.6, Угол в плоскости XY =     90
                  Дельта X =         0.0, Дельта Y =      1779.6, Дельта Z =    
     0.0
Омская птица вне форума  
 
Непрочитано 14.02.2014, 15:20
1 | #7
Alan

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


Оформил как команду.
1. Загрузи приложенный текст
2. Набери в комстроке nz_restang для выполнения

Прямоугольники НЕ строятся по отрезкам в слое 0 и с буквами в начале имени
Вложения
Тип файла: lsp Nz_Restang.LSP (1.6 Кб, 90 просмотров)
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума  
 
Автор темы   Непрочитано 14.02.2014, 15:25
#8
Омская птица


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


Круто!!! Спасибо
Омская птица вне форума  
 
Непрочитано 16.06.2016, 18:36
#9
Rusakov.A.A.


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


Полезный код! А как быть если необходимо преобразовать прямоугольник в линию?одна сторона всегда постоянной длины.
Rusakov.A.A. вне форума  
 
Непрочитано 22.06.2016, 12:13
#10
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Цитата:
Сообщение от Rusakov.A.A. Посмотреть сообщение
Полезный код! А как быть если необходимо преобразовать прямоугольник в линию?одна сторона всегда постоянной длины.
Очевидно, писать другой полезный код...
Boxa вне форума  
 
Непрочитано 22.06.2016, 15:20
#11
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


В AutoCAD'е нет объекта "прямоугольник".
Profan вне форума  
 
Непрочитано 22.06.2016, 15:26
#12
Geor9e

инженер-обструктор
 
Регистрация: 20.04.2016
Сообщений: 162


Offtop: Profan, раз пошла такая пьянка, объекта "линия" тоже нет
Geor9e вне форума  
 
Непрочитано 22.06.2016, 15:36
#13
Кулик Алексей aka kpblc
Moderator

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


_.xline отменили?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.06.2016, 15:47
#14
Geor9e

инженер-обструктор
 
Регистрация: 20.04.2016
Сообщений: 162


Offtop: Кулик Алексей aka kpblc, так она же "ПРЯМАЯ" вроде

Последний раз редактировалось Geor9e, 22.06.2016 в 16:12.
Geor9e вне форума  
 
Непрочитано 22.06.2016, 16:05
#15
Кулик Алексей aka kpblc
Moderator

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


Offtop: Если не ошибаюсь, где-то она фигурировала как "Конструктивная линия".
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.06.2016, 16:15
#16
Geor9e

инженер-обструктор
 
Регистрация: 20.04.2016
Сообщений: 162


Offtop: Кулик Алексей aka kpblc, у меня ещё понимает запрос "линияразметки" (но команда-то при этом всё равно "прямая")
Geor9e вне форума  
 
Непрочитано 02.01.2021, 10:54
#17
Teyso


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


Коллеги, здравствуйте. Извините, что поднимаю старую тему, но нет желания плодить новые. Подскажите. В коде, который тут приведен, неизвестная сторона прямоугольника берется из названия слоя. Так как я не владею навыками программирования, то подскажите, как мне жёстко задать размер той стороны, вместо того, что она берёз значение из названия слоя? Подскажите хотя бы какая это строка в коде. Буду очень благодарен за помощь.
Teyso вне форума  
 
Непрочитано 02.01.2021, 13:35
#18
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


Попробуй вместо n_l (atoi (cdr (assoc 8 (entget el))))
Вставить значение
n_l (значение)
Diman111 вне форума  
 
Непрочитано 12.01.2021, 14:37
#19
Alan

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


Цитата:
Сообщение от Teyso Посмотреть сообщение
жёстко задать размер той стороны, вместо того, что она берёз значение из названия слоя
Чтобы закрыть тему решением этого варианта:
Код:
[Выделить все]
 (defun c:nz_restang
		    (/	   i	 oldl  osmd  pi2   pi_2	 rr1   rr2
		     n_l   c_l	 ss    el    p1	   p2	 n_l   angl
		     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)
	) ;_ конец 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
	  ) ;_ конец 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, 12:39
#20
aafeoktistov


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


Цитата:
Сообщение от Alan Посмотреть сообщение
Чтобы закрыть тему решением этого варианта:
Код:
[Выделить все]
 (defun c:nz_restang
		    (/	   i	 oldl  osmd  pi2   pi_2	 rr1   rr2
		     n_l   c_l	 ss    el    p1	   p2	 n_l   angl
		     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)
	) ;_ конец 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
	  ) ;_ конец 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\" для выполнения ::")

Здравствуйте! А подскажите пожалуйста как сделать еще автоматический поворот получившегося прямоугольника в горизонтальную плоскость если линия от которой он строится вертикальная? Заранее спасибо!
aafeoktistov вне форума  
Ответ
Вернуться   Форум 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