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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп овалы в прмоугольниках

Лисп овалы в прмоугольниках

Ответ
Поиск в этой теме
Непрочитано 27.07.2022, 17:10 #1
Лисп овалы в прмоугольниках
klinker
 
Регистрация: 02.09.2009
Сообщений: 82

Добрый день. Имеется задача встроить в выбранные прямоугольники овалы в Автокаде. Имеется объект с множеством прямоугольников разного размера (сотни штук). Теперь стоит задача в каждый прямоугольник встроить овал. Но всё дело в том, что прямоугольников огромное множество и в каждый необходимо встроить овал, а каждый прямоугольник разного размера и расположен то длинной стороной горизонтально, то вертикально. Может быть кто нибудь подскажет где скачать данный лисп или поделится уже имеющимся. Буду весьма благодарен. Просто данная задача для меня встречается очень часто и она отнимает уйму времени. Прошу вашей помощи в решении данной задачи. Обращаю внимание, что это именно прямоугольники, а не квадраты. Если кот-то сможет написать данный лисп или подскажет где скачать, то буду очень благодарен. Задача очень срочная, если у кого есть решение - поделитесь.
Просмотров: 6550
 
Непрочитано 27.07.2022, 17:30
#2
Кулик Алексей aka kpblc
Moderator

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


И кто мешает создать блок "круг в прямоугольнике" и масштабировать его с разными коэффициентами по разным осям - тайна.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 27.07.2022, 22:39
#3
klinker


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


Вся проблема в том, что прямоугольники уже отрисованы и нужно чтобы эллипс встраивался в уже подготовленные прямоугольники. Их задает другой человек. Мне нужно чтобы он отрисовывался в любом произвольном прямоугольнике, а их очень много.
klinker вне форума  
 
Непрочитано 28.07.2022, 00:49
#4
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,001


Цитата:
Сообщение от klinker Посмотреть сообщение
Задача очень срочная
задача настолько срочная - что даже исходные данные в *.dwg не выложены) Построение эллипса, осталось у прямоугольников получить центр, половину расстояния одной из сторон и отношение двух смежных сегментов и подставить в пример по ссылке.
Сергей812 вне форума  
 
Непрочитано 28.07.2022, 11:28
1 | #5
1958


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


Код:
[Выделить все]
 ;;; овал в прямоугольнике
;;; 28 июля 2022г.
(defun c:el-rec (/ i ssp rec coor vert p1 p2 p3 p4 ang1 ang2 ang pt1 pt2 pt3)
 (vl-load-com)
 (vl-cmdf "_.zoom" "_e")
 (setq i -1)
 (setq ssp (ssget "_X" '((0 . "LWPOLYLINE"))))
 (while (< i (1- (sslength ssp)))
  (setq rec  (entget (ssname ssp (setq i (1+ i))))
        coor (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) rec))
        vert (length coor)
  )
  (if (= (logand (cdr (assoc 70 rec)) 1) 1)
   (if (= vert 4)
    (progn (setq p1   (nth 0 coor)
                 p2   (nth 1 coor)
                 p3   (nth 2 coor)
                 p4   (nth 3 coor)
                 ang1 (angle p1 p2)
                 ang2 (angle p2 p3)
                 ang  (abs (- ang2 ang1))
           )
           (if (= ang (* 1.5 pi))
            (setq ang (* 0.5 pi))
           )
           (if (= ang (* 0.5 pi))
            (progn (setq pt1 (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5))
                         pt2 (mapcar '* (mapcar '+ p3 p4) '(0.5 0.5))
                         pt3 (mapcar '* (mapcar '+ p2 p3) '(0.5 0.5))
                   )
                   (vl-cmdf "_ellipse" pt1 pt2 pt3)
            )
           )
    )
   )
  )
 )
)
1958 вне форума  
 
Непрочитано 28.07.2022, 12:01
#6
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


овал, эллипс... а м.б. там нужен стадион?)
koMon вне форума  
 
Непрочитано 28.07.2022, 12:18
#7
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,001


Цитата:
Сообщение от 1958 Посмотреть сообщение
(setq ssp (ssget "_X" '((0 . "LWPOLYLINE"))))
чудная работа. Один
Цитата:
Сообщение от klinker Посмотреть сообщение
уже подготовленные прямоугольники. Их задает другой человек.
в пустом файле, другой вписывает в них эллипсы)
Сергей812 вне форума  
 
Непрочитано 31.07.2022, 09:54
#8
Ingpro


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


1958, а есть возможность сделать выбор прямоугольников (одиночный и рамкой несколько).
Если прямоугольник под углом - эллипс не чертится, см. вложение... Можно добавить и под углом?
Миниатюры
Нажмите на изображение для увеличения
Название: 2022-07-31.png
Просмотров: 46
Размер:	28.1 Кб
ID:	248983  

Последний раз редактировалось Ingpro, 31.07.2022 в 11:37.
Ingpro вне форума  
 
Непрочитано 31.07.2022, 14:54
#9
1958


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


Цитата:
Сообщение от Ingpro Посмотреть сообщение
Если прямоугольник под углом - эллипс не чертится, см. вложение... Можно добавить и под углом?
У меня чертится. Дайте ваш чертеж (желательно формата AC2007).

Последний раз редактировалось 1958, 01.08.2022 в 06:18.
1958 вне форума  
 
Непрочитано 31.07.2022, 17:06
#10
Ingpro


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


Вот чертеж.
Вложения
Тип файла: dwg
DWG 2007
el-rec_АС2007.dwg (82.1 Кб, 20 просмотров)
Ingpro вне форума  
 
Непрочитано 31.07.2022, 21:16
1 | #11
1958


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


Цитата:
Сообщение от Ingpro Посмотреть сообщение
а есть возможность сделать выбор прямоугольников (одиночный и рамкой несколько).
Если прямоугольник под углом - эллипс не чертится, см. вложение... Можно добавить и под углом?
Попробуйте такой вариант:
Код:
[Выделить все]
 ;;; построение эллипсов в произвольно выбранных прямоугольниках
;;; 31 июля 2022г.
(defun c:er (/ i ssp rec coor vert p1 p2 p3 p4 ang1 ang2 ang pt1 pt2 pt3)
 (vl-load-com)
 (vl-cmdf "_.zoom" "_e")
 (setq i -1)
 (setq ssp (ssget '((0 . "LWPOLYLINE") (70 . 1))))
 (while (< i (1- (sslength ssp)))
  (setq rec  (entget (ssname ssp (setq i (1+ i))))
        coor (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) rec))
        vert (length coor)
  )
  (if (= vert 4)
   (progn (setq p1   (nth 0 coor)
                p2   (nth 1 coor)
                p3   (nth 2 coor)
                p4   (nth 3 coor)
                ang1 (angle p1 p2)
                ang2 (angle p2 p3)
                ang  (abs (- ang2 ang1))
          )
          (if (equal ang (* 1.5 pi) 1e-6)
           (setq ang (* 0.5 pi))
          )
          (if (equal ang (* 0.5 pi) 1e-6)
           (progn (setq pt1 (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5)))
                  (setq pt2 (mapcar '* (mapcar '+ p3 p4) '(0.5 0.5)))
                  (setq pt3 (mapcar '* (mapcar '+ p2 p3) '(0.5 0.5)))
                  (vl-cmdf "_ellipse" pt1 pt2 pt3)
           )
          )
   )
  )
 )
)
1958 вне форума  
 
Непрочитано 01.08.2022, 11:48
#12
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


@1958,
Нажмите на изображение для увеличения
Название: Testing.jpg
Просмотров: 67
Размер:	57.2 Кб
ID:	248999
koMon вне форума  
 
Непрочитано 01.08.2022, 14:38
#13
1958


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Картинки это красиво. Но я не умею пользоваться системами координат. Вы бы лучше предложили необходимые на ваш взгляд правки кода, а я бы попытался разобраться.
1958 вне форума  
 
Непрочитано 01.08.2022, 15:23
#14
Ingpro


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


Спасибо, 1958! Всё отлично работает, выбирается рамкой и отдельно, и эллипсы чертятся и в прямоугольниках под углом.
Ingpro вне форума  
 
Непрочитано 01.08.2022, 15:30
1 | #15
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от 1958 Посмотреть сообщение
правки кода

Код:
[Выделить все]
 ;**************************************************************************************************************************************************************************

(defun c:ellipse_in_rectangle (/ ename_index ignore_empty_sset rectangle_sset vertices_list bulges_list center_point minor_axis_point major_axis_point radius_ratio)
	(defun half (argument) (* 0.5 argument))
	(repeat (sslength (setq ename_index -1
							ignore_empty_sset (while (null (setq rectangle_sset (vl-catch-all-apply 'ssget (list '((0 . "lwpolyline") (-4 . "&=") (70 . 1) (90 . 4)))))))
							rectangle_sset (cond
													(
														(vl-catch-all-error-p rectangle_sset)
															(princ "\nОтмена команды")
															(ssadd)
													)
													(
														t
															rectangle_sset
													)
									  	   )
					   )
			)
			(setq vertices_list (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 10 (car group))) (entget (ssname rectangle_sset (setq ename_index (1+ ename_index))))))
				  bulges_list (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 42 (car group))) (entget (ssname rectangle_sset ename_index))))
			)
			(if (and
					 (equal (distance (nth 0 vertices_list) (nth 2 vertices_list)) (distance (nth 1 vertices_list) (nth 3 vertices_list)) 1e-8)
					 (equal (angle (nth 0 vertices_list) (nth 1 vertices_list)) (angle (nth 3 vertices_list) (nth 2 vertices_list)) 1e-8)
					 (equal (angle (nth 1 vertices_list) (nth 2 vertices_list)) (angle (nth 0 vertices_list) (nth 3 vertices_list)) 1e-8)
					 (zerop (apply '+ (mapcar 'abs bulges_list)))
				)
					(progn
						(setq center_point (mapcar 'half (mapcar '+ (nth 0 vertices_list) (nth 2 vertices_list)))
					  		  minor_axis_point (mapcar 'half (mapcar '+ (nth 0 vertices_list) (nth 1 vertices_list)))
					  		  major_axis_point (mapcar 'half (mapcar '+ (nth 1 vertices_list) (nth 2 vertices_list)))
					  		  radius_ratio (/ (distance center_point minor_axis_point) (distance center_point major_axis_point))
						)
						(if (< 1 radius_ratio)
								(setq radius_ratio (/ 1.0 radius_ratio)
									  major_axis_point (mapcar '- minor_axis_point center_point)
								)
								(setq major_axis_point (mapcar '- major_axis_point center_point))
						)
						(vla-addellipse (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
										(vlax-3d-point center_point)
										(vlax-3d-point major_axis_point)
										radius_ratio
						)
					)
			)
	)
	(princ)
)

;**************************************************************************************************************************************************************************

Последний раз редактировалось koMon, 04.08.2022 в 16:50.
koMon вне форума  
 
Непрочитано 01.08.2022, 19:35
#16
1958


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


Цитата:
Сообщение от koMon Посмотреть сообщение
м.б. как-то так
Интересно. Это совершено другой код на ActiveX, с моим ничего похожего. За код dxf 90 (list '((0 . "lwpolyline") (70 . 1) (90 . 4))) спасибо, что-то я про него забыл (если честно, то и не знал).
1958 вне форума  
 
Непрочитано 01.08.2022, 19:43
#17
Кулик Алексей aka kpblc
Moderator

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


Я бы для гарантии сделал в 70 группе не только 1, но и 129.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 01.08.2022, 20:05
#18
1958


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Я бы для гарантии сделал в 70 группе не только 1, но и 129.
Как?
1958 вне форума  
 
Непрочитано 01.08.2022, 20:37
#19
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
но и 129
128

----- добавлено через ~3 мин. -----
Ну уж если наверняка, то Closed получше будет имхо.
koMon вне форума  
 
Непрочитано 01.08.2022, 21:45
1 | #20
Кулик Алексей aka kpblc
Moderator

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


128 - это признак генерации типа линии.
Цитата:
Сообщение от 1958 Посмотреть сообщение
Как?
Код:
[Выделить все]
 (ssget '((0 . "LWPOLYLNE") (90 . 4) (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))
Пишу насухую, могу ошибиться
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп овалы в прмоугольниках

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как из ObjectArx (.Net) вызвать функцию Лисп, передать в нее параметры и получить измененные параметры назад? nickname2019 Программирование 9 16.04.2020 06:16
Интересно где работают ЛИСП программисты? dextron3 LISP 114 17.12.2017 13:53
Начиная с 14й версии автокада некорректно работает лисп Kllrnn LISP 4 20.08.2015 11:56
Лисп для копирования данных нескольких мтекстов по принципу расположения. Red Nova LISP 14 18.06.2008 22:08