Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Перенос окружностей на полилинию.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Autocad 2004.
Смысл задания - перенести заданные окружности на полилинию, причем на 1 прямолинейном отрезке должна находиться одна окружность. Необходимо перенести все окружности, либо закончить при отсутствии свободных отрезков на полилинии.
Пока есть предположение о том, чтобы переносить центр на середину отрезка полилинии, но вот с практической реализацией пока проблемы.
Заранее спасибо, если кто сможет что подсказать.
Я вам могу на .NET это написать :D Но, к сожалению, работу в лиспе с полилиниями уже не помню :(
А так - задача достаточно несложная. Могу сказать порядок действий:
1. Создать набор окружностей. Естественно с ограничением выбора
2. Выбрать одну полилинию. Тоже с ограничением выбора. А можно просто функцию прекращать, если выбрано не то.
3. В цикле пройти по всем вершинам -1 (если мне память не изменяет, то вроде по сегментам нельзя итерацию делать - но могу и ошибаться), при этом находя центр сегмента и меняя радиус i-той окружности из набора. Когда кончаться вершины функция сама собой и завершится.
В цикле пройти по всем вершинам -1 (если мне память не изменяет, то вроде по сегментам нельзя итерацию делать - но могу и ошибаться), при этом находя центр сегмента
В этом и основная проблема.
Пыталась найти литературу либо еще что-то по тему, в каких свойствах можно найти точки полилинии, пока успехом не завершилось.
(command "_pline" '(150 200) '(30 250) '(40 400) '(120 500) '(180 500)"")
(setq po (entlast))
<Entity name: 7ef4fe88>
(setq pr (entget po))
((-1 . <Entity name: 7ef4fe88>) (0 . "LWPOLYLINE") (330 . <Entity name:
7ef4fcf8>) (5 . "81") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
(100 . "AcDbPolyline") (90 . 5) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10
150.0 200.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 30.0 250.0) (40 . 0.0) (41 .
0.0) (42 . 0.0) (10 40.0 400.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 120.0
500.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 180.0 500.0) (40 . 0.0) (41 . 0.0)
(42 . 0.0) (210 0.0 0.0 1.0))
Предположила как можно написать, но видимо где-то косяк.
Пока окружности задавала в программе, чтоб проще отловить ошибку.
;Первый кривой вариант с не совсем правильным порядком комменд в ифах и вне их
(defun s1()
(command "_circle" '(300 500) 70)
(command "_circle" '(500 500) 100)
(command "_circle" '(100 200) 50)
(command "_circle" '(300 450) 75)
(command "_circle" '(500 1000) 60)
(command "_circle" '(500 50) 100)
(setq beg (entnext)); первая окружность
(setq end (entlast)); последняя окружность
(command "_pline" '(150 200) '(30 250) '(40 400) '(120 500) '(180 500)"")
(setq po (entlast)) ; полилиния
(setq pr (entget po)) ; свойства полилинии
(setq priz (car pr)) ; первый признак функции
(setq pr (cdr pr)) ; остальные признаки
(setq priz1 (car priz)) ; номер принака
(if (eq priz1 10) ; если это точка
(setq dot1 (cdr priz))) ; список из хвоста (координаты точки)
(while pr ; цикл
(setq priz (car pr)) ; первый признак из списка
(setq pr (cdr pr)) ; убираем его из списка признаков
(setq priz1 (car priz)) ; выделяем номер признака
(if (eq priz1 10) ; если точка
(setq dot2 (cdr priz))) ; выбираем точку 2
(setq a (list (/ (+(car dot1) (car dot2)) 2) (/ (+ (cadr dot1) (cadr dot2)) 2))) ;середина отрезка
(setq prop (entget beg)) ; список свойств окружности
(while prop ;аналогичный цикл по свойствам окружности
(setq prop1 (car prop))
(setq prop (cdr prop))
(setq propn (car prop1))
(if (eq propn 10)
(subst (prop1) (list propn a)); Тут уже сомнения, но предполагалась замена центра
;на точку середины сегмента полилинии
)
)
(setq beg (entnext beg)); переход к следующей окружности
(setq dot1 dot2) ; сдвиг начальной точки отрезка для работы с новым сегментом
)
)
;Вариант номер четыре,второй исправила, ошибки с nil нет bad fuction
(defun s1()
(command "_circle" '(300 500) 70)
(command "_circle" '(500 500) 100)
(command "_circle" '(100 200) 50)
(command "_circle" '(300 450) 75)
(command "_circle" '(500 1000) 60)
(command "_circle" '(500 50) 100)
(setq beg (entnext))
(setq end (entlast))
(command "_pline" '(150 200) '(30 250) '(40 400) '(120 500) '(180 500)"")
(setq po (entlast))
(setq pr (entget po))
( while (eq dot1 nil)
(setq priz (car pr))
(setq pr (cdr pr))
(setq priz1 (car priz))
(if (eq priz1 10)
(setq dot1 (cdr priz)))
)
(while pr
(setq priz (car pr))
(setq pr (cdr pr))
(setq priz1 (car priz))
(if (eq priz1 10)
( progn
(setq dot2 (cdr priz))
(setq a (list (/ (+(car dot1) (car dot2)) 2) (/ (+ (cadr dot1) (cadr dot2)) 2)))
(setq prop (entget beg))
(while prop
(setq prop1 (car prop))
(setq prop (cdr prop))
(setq propn (car prop1))
(if (eq propn 10)
(progn
(setq sent (cdr prop1))
(subst (prop1) (list propn a))
(setq beg (entnext beg))
(setq dot1 dot2)
)
)
)
)
)
)
)[S]Command: ; error: bad argument type: numberp: nil[/S]
[S]Последнее фигурирующее в выполненном автокадом - полилиния, результатов присвоения переменным первого и посленего начерченных элементов нет.[/S]
Command: ; error: bad function: (10 300.0 500.0 0.0)
Похоже, криво идет работа с найденным центром первой окружности. Пока думаю.
Причину найти пока не получается, увы
Почитайте про ActiveX. Там точно есть доступ к вершинам полилинии. Ну а если полазить по форуму - найдете и пример кода
могу посоветовать книгу Николай Полещук,Петр Лоскутов Autolisp и visual Lisp, в Среде Autocad.
я ее на Ozon.ru заказывал.
((-1 . <Entity name: 7ef4fe88>) (0 . "LWPOLYLINE") (330 . <Entity name:
7ef4fcf8>) (5 . "81") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
(100 . "AcDbPolyline") (90 . 5) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10
150.0 200.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 30.0 250.0) (40 . 0.0) (41 .
0.0) (42 . 0.0) (10 40.0 400.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 120.0
500.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 180.0 500.0) (40 . 0.0) (41 . 0.0)
(42 . 0.0) (210 0.0 0.0 1.0))
это список точечных пар объекта чтоб получить координаты вершин полилинии нужно извлечь координаты из списка либо функцией assoc (assoc 10(ключ доступа к точеной паре) '( )список), но функция не подойдет т.к. извлекает первую точеную пару с указанным кодом. либо использовать функцию nth которая извлекает содержимое списка по его порядковому номеру начиная с 0 (nth 0 '()) метод не универсальный т.к. если присовить цвет вес тип то порядковый номер в списке точечных пар объекта появятся новые точечные пары,и порядковые номера поменяются.
, но функция не подойдет т.к. извлекает первую точеную пару с указанным кодом
Для этого есть massoc
(defun massoc ( key alist / ret)
;;; key - код поля
;;; alist - список
;;; Пример
;;; (massoc 10 (entget(car(entsel "Выбери полилинию"))))
(foreach item alist
(if (= (car item) key)
(setq ret (cons (cdr item) ret))
)
)
(reverse ret)
)Зная список точек можно построить и сегменты
(defun mip-mkseg ( lst / ret z1 z2)
;|===========================================
* Создание сегментов
* Параметры вызова:
* lst-point — список точек
* Примеры вызова:
* (mip-mkseg '(1 2 3 4))
* Результат: ((1 2) (2 3) (3 4))
================================================|;
(setq z1 (car lst))
(foreach z2 (cdr lst)
(setq ret (cons (list z1 z2) ret)
z1 z2)
)
(reverse ret)
) ;_ end of defun
(mapcar 'cdr (vl-remove-if-not '(LAMBDA(x)(= (car x) 10)) (entget ent)))
Это в ОСК.
Координаты середин сегментов в WCS:\
(defun test (/ vl count seg res)
(setq vl (vlax-ename->vla-object (car (entsel "\nSelect pline : ")))
count -0.5
) ;_ end of setq
(repeat (1-
(/
(length (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates vl))
) ;_ end of vlax-safearray->list
) ;_ end of length
2
) ;_ end of /
) ;_ end of 1-
(setq seg (vlax-curve-getpointatparam
vl
(setq count (1+ count))
) ;_ end of vlax-curve-getpointatparam
res (cons seg res)
) ;_ end of setq
) ;_ end of while
(reverse res)
) ;_ end of defunПроверка:
(mapcar '(LAMBDA(x)(entmakex (list (cons 0 "POINT") (cons 10 x) (cons 62 1)))) (setq lst (test)))
---
Добавлено: код некрасивый, но глянец наводить некогда :(
я конечно совсем не программист, но попробовал по вашему заданию
Смысл задания - перенести заданные окружности на полилинию, причем на 1 прямолинейном отрезке должна находиться одна окружность. Необходимо перенести все окружности, либо закончить при отсутствии свободных отрезков на полилинии.
сделать что-то похожее.
в моем коде конечно вообще ни каким глянцем далеко не пахнет. но работает вроде..
(defun c:krug_v_lin (/)
(setq list_ver '());пустой список
(setq list_centr '());пустой список
(setq nab_cir (ssget "_X" (list (cons 0 "CIRCLE"))));создаем набор окружностей
(setq i -1)
(setq kol_prim (sslength nab_cir));количество примитивов в наборе
(repeat kol_prim; количество повторений в цикле
(setq i (1+ i));номер примитва в наборе певый =0
(setq koord_prim (cdr (assoc 10 (entget(ssname nab_cir i)))));извлекаем из списка примитива координаты вершины по номеру в списке
(setq list_centr (append list_centr (list koord_prim))));наполняем список координатами вершин <конец repeat>
(setq n_lin (car (nentsel "\nУкажите полилинию :")));получаем имя объекта
(setq lin_sp (entget n_lin));получаем список объекта dxf
(setq n (cdr(assoc 90 lin_sp)));получаем количество вершин полилинии
(setq i 10); присваиваем значение переменной i
(repeat n
(setq i (+ i 4));последовательно увеличиваем переменную i
(setq koord_ver (cdr (nth i lin_sp))); получаем координаты вершин полилинии по их порядковму номеру необходимо условие: полилиния значения "Послою" у всех свойств
(setq list_ver (append list_ver (list koord_ver))));создаем список списков коодинат вершин полилинии конец repeat
(setq a -1); присваиваем значение переменной a
(setq b 0); присваиваем значение переменной b
(repeat (fix(- n 1));определяем колоичество повторений
(setq a (1+ a));увеличиваем на один n раз
(setq b (1+ b));увеличиваем на один n раз
(setq p1 (nth a list_ver));координата вершины первой
(setq p2 (nth b list_ver));координата вершины следующей
(setq rast (sqrt(+(expt(-(car p2) (car p1))2) (expt(-(car(cdr p2)) (car(cdr p1)))2))));вычисляем по формуле I=sqrt((x2-x1)^2+(y2-y1)^2)
;(setq rast (distance p1 p2))
(setq list_rast (append list_rast (list rast)))
(setq xyz (list (/(+(car p2) (car p1))2) (/(+(car(cdr p2)) (car(cdr p1)))2) 0.0));вычисляем точку вставки круга по формуле x=(x2+x1)/2 и y=(y2+y1)/2
(command "_move" (ssname nab_cir a) "" (nth a list_centr) xyz );переносим окружности в центры полилинии
)вот что-то такое
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Перенос окружностей на полилинию.
Форум работает на PunBB, при поддержке Informer Technologies, Inc
