[RedMambo]

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

Имеется:
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.

Подскажите, плз, как сформировать команду.

[kp+]

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

PS стоит ли изобретать велосипед, когда есть, например, xclip из ET. Тоже, кстати, на лиспе и с открытым кодом.

[RedMambo]

(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)
)

[kp+]

Посмотрите еще тут: https://forum.dwg.ru/showthread.php?t=42985

[trir]

код надо офрормлять
-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 мин. -----
гораздо проще обрезать исходную поверхность...