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

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

AutoLisp формирование контура обрезки

Ответ
Поиск в этой теме
Непрочитано 25.01.2022, 22:48 #1
AutoLisp формирование контура обрезки
RedMambo
 
Регистрация: 25.01.2022
Сообщений: 2

Здравствуйте, помогите, пожалуйста, с задачей.

Имеется:
1) Набор многоугольников произвольной формы в слое. Они перебираются в цикле:

(setq Testing (ssget "_X" '((0 . "LWPOLYLINE" )(8 . "Тестовый"))))
(setq main_i 0 main_count (sslength Testing))
(while (<= main_i (1- main_count))
(setq main_i (1+ main_i)))

2) Внутри цикла есть сформированный список result_list с координатами точек будущего контура обрезки. Например:

((5.20734e+06 4.93121e+06) (5.20734e+06 4.93122e+06) (5.20733e+06 4.93121e+06) (5.20733e+06 4.93122e+06) (5.20732e+06 4.93122e+06) (5.20733e+06 4.93121e+06) (5.20732e+06 4.93121e+06))

3)В конце каждой итерации нужно сформировать команду обрезки внутри текущего многоугольника по контуру из списка.

(sssetfirst nil testing)
(vl-cmdf "обрезать")
(vl-cmdf "линия")
(foreach item result_list
(vl-cmdf item))
(vl-cmdf "")
(vl-cmdf "")

Такой код работает только с одним объектом вне цикла - линии внутри многоугольника обрезаются. Не работает внутри while.

Подскажите, плз, как сформировать команду.
Просмотров: 2692
 
Непрочитано 26.01.2022, 10:34
#2
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Днепройт
Сообщений: 4,855


Без полного кода и примера обрабатываемого dwg можно только гадать на кофейной гуще. Но один момент бросается в глаза: с какой целью каждая опция одной и той же команды вводится через отдельную vl-cmdf? Может, в этом все дело? Не лучше поставить все опции в одну vl-cmdf? Не помню, как vl-cmdf относится к списку примитивов, но всегда можно преобразовать его в набор, с ним точно проблем не будет.

PS стоит ли изобретать велосипед, когда есть, например, xclip из ET. Тоже, кстати, на лиспе и с открытым кодом.
__________________
Одно меня лишь радует - я это вижу сам! (С)

Последний раз редактировалось kp+, 26.01.2022 в 13:10.
kp+ вне форума  
 
Автор темы   Непрочитано 26.01.2022, 11:41
#3
RedMambo


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


(setq Testing (ssget "_X" '((0 . "LWPOLYLINE" )(8 . "Тестовый"))))
(setq main_i 0 main_count (sslength Testing))
(while (<= main_i (1- main_count))
(setq Current_Pirme(entget (ssname Testing main_i)))
(setq Clear_Pirme '())
(foreach item Current_Pirme
(if (= 10 (nth 0 item))
(progn
(setq Clear_Pirme (append Clear_Pirme (list item)))
)
)
)
(princ Clear_Pirme)
(setq check_closssuare_X1 (nth 1(nth 0 Clear_Pirme)))
(setq check_closssuare_X2 (nth 1 (nth (- (length Clear_Pirme) 1) Clear_Pirme)))
(setq check_closssuare_Y1 (nth 2(nth 0 Clear_Pirme)))
(setq check_closssuare_Y2 (nth 2 (nth (- (length Clear_Pirme) 1) Clear_Pirme)))
(if (or(not (= check_closssuare_X1 check_closssuare_X2)) (not (= check_closssuare_Y1 check_closssuare_Y2)) )
(progn (setq Clear_Pirme (append Clear_Pirme (list (list 10 check_closssuare_X1 check_closssuare_Y1))))))
(setq i 0 j 1 f 2 count (length Clear_Pirme) dxmax 0 checklist '( ) side_list '( ))
(while (< i (- count 1) )
(setq x1 (nth 1(nth i Clear_Pirme)) y1 (nth 2(nth i Clear_Pirme))
x2 (nth 1(nth j Clear_Pirme)) y2 (nth 2(nth j Clear_Pirme))
x3 (nth 1(nth f Clear_Pirme)) y3 (nth 2(nth f Clear_Pirme))
)
(setq middle1x (* (+ x1 x3) 0.5))
(setq middle1y (* (+ y1 y3) 0.5))
(setq check1X (+ x2 (* 0.01 (- middle1x x2) ) ))
(setq check1Y (+ y2 (* 0.01 (- middle1y y2) ) ))
(setq check2X (+ middle1x (* 1.01 (- x2 middle1x ) ) ))
(setq check2Y (+ middle1y (* 1.01 (- y2 middle1y ) ) ))
(setq checklist (append checklist (list (list check1X check1Y check2X check2Y)) ) )
(setq side_list (append side_list (list(list x1 y1 x2 y2 ) ) ))
(if (> x1 dxmax)
(progn
(setq dxmax x1)))
(setq i (1+ i))
(setq j (1+ j))
(setq f (1+ f))
(if (>= f count)
(progn(setq f 1)
)
)
)
(princ checklist)
(princ side_list)
(setq result_list '())
(setq x (nth 1 (nth 0 Clear_Pirme)) )
(setq y (nth 2 (nth 0 Clear_Pirme)) )
(foreach point checklist
(setq summ_intersect 0)
(setq check_intersect "unknown")
(foreach side side_list
(setq test (inters (list (nth 0 side) (nth 1 side)) (list (nth 2 side) (nth 3 side)) (list (nth 0 point) (nth 1 point)) (list (+ 2 dxmax) (nth 1 point)) ) )
(if (not (= test nil))
(progn
(setq summ_intersect (1+ summ_intersect))
)
)
)
(if (
not ( = (rem summ_intersect 2) 0 )
)
(progn
(setq result_list (append result_list (list(list (nth 0 point) (nth 1 point))) ))
)
(progn
(setq result_list (append result_list (list(list (nth 2 point) (nth 3 point))) ))
)
)
)
(princ "\n")
(princ "начало списка")
(princ result_list)
(princ "конец списка")
(princ "\n")
(sssetfirst nil testing)
(vl-cmdf "плиния")
(foreach item result_list
(vl-cmdf item))
(vl-cmdf "З")
(setq main_i (1+ main_i))
)


В итоге я получаю контур в списке result list, и могу его нарисовать в многоугольниках полилиниями (в рисунке работает). Не получается вместо полилиний делать такую - же обрезку. Спасите, пожалуйста.

upd:

Список выведен из цикла, в итоге result_list получается:

(("обрезать") ("линия") (5.20424e+006 4.92714e+006) (5.20424e+006 4.92713e+006) (5.20423e+006 4.92713e+006) (5.20423e+006 4.92713e+006) (5.20423e+006 4.92714e+006) "" "обрезать" "линия" (5.20426e+006 4.92714e+006) (5.20426e+006 4.92714e+006) (5.20426e+006 4.92714e+006) (5.20426e+006 4.92714e+006) (5.20426e+006 4.92714e+006) "" "обрезать" "линия")

Как сделать, чтобы далее заработало?

(sssetfirst nil testing)
(foreach pnt result_list
(command pnt)
)
Вложения
Тип файла: dwg
DWG 2013
тестовый файл.dwg (5.92 Мб, 6 просмотров)
Тип файла: dwg
DWG 2013
тестовый.dwg (5.90 Мб, 3 просмотров)

Последний раз редактировалось RedMambo, 26.01.2022 в 16:48.
RedMambo вне форума  
 
Непрочитано 27.01.2022, 12:06
#4
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Днепройт
Сообщений: 4,855


Посмотрите еще тут: https://forum.dwg.ru/showthread.php?t=42985
__________________
Одно меня лишь радует - я это вижу сам! (С)
kp+ вне форума  
 
Непрочитано 27.01.2022, 12:54
#5
trir


 
Регистрация: 18.12.2010
Сообщений: 4,758


код надо офрормлять
-CODE]-LISP]-/LISP]-/CODE]

Код:
[Выделить все]
(setq Testing (ssget "_X" '((0 . "LWPOLYLINE" )(8 . "Тестовый"))))
(setq main_i 0 main_count (sslength Testing))
(while (<= main_i (1- main_count))
(setq Current_Pirme(entget (ssname Testing main_i)))
(setq Clear_Pirme '())
(foreach item Current_Pirme
(if (= 10 (nth 0 item))
(progn
(setq Clear_Pirme (append Clear_Pirme (list item)))
)
)
)
(princ Clear_Pirme)
(setq check_closssuare_X1 (nth 1(nth 0 Clear_Pirme)))
(setq check_closssuare_X2 (nth 1 (nth (- (length Clear_Pirme) 1) Clear_Pirme)))
(setq check_closssuare_Y1 (nth 2(nth 0 Clear_Pirme)))
(setq check_closssuare_Y2 (nth 2 (nth (- (length Clear_Pirme) 1) Clear_Pirme)))
(if (or(not (= check_closssuare_X1 check_closssuare_X2)) (not (= check_closssuare_Y1 check_closssuare_Y2)) )
(progn (setq Clear_Pirme (append Clear_Pirme (list (list 10 check_closssuare_X1 check_closssuare_Y1))))))
(setq i 0 j 1 f 2 count (length Clear_Pirme) dxmax 0 checklist '( ) side_list '( ))
(while (< i (- count 1) )
(setq x1 (nth 1(nth i Clear_Pirme)) y1 (nth 2(nth i Clear_Pirme))
x2 (nth 1(nth j Clear_Pirme)) y2 (nth 2(nth j Clear_Pirme))
x3 (nth 1(nth f Clear_Pirme)) y3 (nth 2(nth f Clear_Pirme))
)
(setq middle1x (* (+ x1 x3) 0.5))
(setq middle1y (* (+ y1 y3) 0.5))
(setq check1X (+ x2 (* 0.01 (- middle1x x2) ) ))
(setq check1Y (+ y2 (* 0.01 (- middle1y y2) ) ))
(setq check2X (+ middle1x (* 1.01 (- x2 middle1x ) ) ))
(setq check2Y (+ middle1y (* 1.01 (- y2 middle1y ) ) ))
(setq checklist (append checklist (list (list check1X check1Y check2X check2Y)) ) )
(setq side_list (append side_list (list(list x1 y1 x2 y2 ) ) ))
(if (> x1 dxmax)
(progn
(setq dxmax x1)))
(setq i (1+ i))
(setq j (1+ j))
(setq f (1+ f))
(if (>= f count)
(progn(setq f 1)
)
)
)
(princ checklist)
(princ side_list)
(setq result_list '())
(setq x (nth 1 (nth 0 Clear_Pirme)) )
(setq y (nth 2 (nth 0 Clear_Pirme)) )
(foreach point checklist
(setq summ_intersect 0)
(setq check_intersect "unknown")
(foreach side side_list
(setq test (inters (list (nth 0 side) (nth 1 side)) (list (nth 2 side) (nth 3 side)) (list (nth 0 point) (nth 1 point)) (list (+ 2 dxmax) (nth 1 point)) ) )
(if (not (= test nil))
(progn
(setq summ_intersect (1+ summ_intersect))
)
)
)
(if (
not ( = (rem summ_intersect 2) 0 )
)
(progn
(setq result_list (append result_list (list(list (nth 0 point) (nth 1 point))) ))
)
(progn
(setq result_list (append result_list (list(list (nth 2 point) (nth 3 point))) ))
)
)
)
(princ "\n")
(princ "начало списка")
(princ result_list)
(princ "конец списка")
(princ "\n")
(sssetfirst nil testing)
(vl-cmdf "плиния")
(foreach item result_list
(vl-cmdf item))
(vl-cmdf "З")
(setq main_i (1+ main_i))
)
----- добавлено через ~5 мин. -----
гораздо проще обрезать исходную поверхность...
trir вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > AutoLisp формирование контура обрезки

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Построение габаритного контура для нескольких объектов с заданием поворота этого контура. Profan Готовые программы 0 26.01.2017 10:52
Литература по AutoLISP на русском языке PeterPeter LISP 43 22.09.2015 10:33
Здравствуйте, при заливке контура в автокаде пропадет граница самого контура, в чем может быть причина? Студент1990 AutoCAD 1 12.06.2012 10:23
Сопротивления контура заземления koteyko Инженерные сети 2 02.06.2010 22:41
Создание нескольких границ обрезки к одному линковонному чертежу hwd AutoCAD 1 22.01.2010 19:40