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

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

Новые команды для работы с полилинией

Ответ
Поиск в этой теме
Непрочитано 14.09.2006, 13:30 4 |
Новые команды для работы с полилинией
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,990

Данный набор программ является коллективным продуктом участников форумов autocad.ru и dwg.ru с моими доработками.
Захотелось собрать все программы для работы с полилиниями воедино и оформить как полагается.

=========== Доступные команды PLTOOLS=================
Редакция 17.06.2014
PL-JOIN -Объединение выбранных полилиний
PL-VFI -вставка вершин в выбранной полилинии в местах пересечения с
указанными полилиниями, линиями, дугами
PL-JOIN3D -Объединение 3D полилиний
PL-L2A -Замена линейного сегмента в полилинии дуговым сегментом.
PL-A2L -Замена дугового сегмента в полилинии линейным сегментом.
PL-DIV -Разбивает выбранный сегмент полилинии на указанное количество
сегментов или через указанное расстояние
PL-DIVAll -Разбивает все сегменты полилинии на указанное количество
сегментов или через указанное расстояние
PL-VxAdd -Добавляет новую вершину к полилинии
ENTREVS -Реверс объекта
ENTREV -Реверс объектов (множественный выбор)
PL-CW -Реверс выбранных полилиний по часовой стрелке
PL-CCW -Реверс выбранных полилиний против часовой стрелки
PL-VxRdc -Удаление вершин полилиний, которые лежат на одной прямой
PL-VxDel -Удаление выбранной вершины
pl-VxOpt -Удаление совпадающих вершин из полилинии
PL-NoArc -Аппроксимация дуговых сегментов полилинии
PL-Clone -Построение полилинии путем копирования ее сегментов
PL-VxMove -Перемещение вершин полилинии
PL-Vx1 -Изменение начала полилинии
ConvTo2d -Преобразование линейных объектов в 2D полилинии
ConvTo3d -Преобразование линейных объектов в 3D полилинии
MPL -Построение средней линии Более продвинутая версия Rollin_Ball.lsp Find MidBoundary between two polylines.
R3P -Прямоугольгик по 3-м точкам
PL-P90 -Рисование перпендикулярных друг к другу сегментов полилинии
PL-CSE -Объединение 2d полилиний по примитиву
PL-SgWidth -Изменить ширину сегмента полилинии

Реверс дуговых сегментов полилинии из #79
На дуговых сегментах полилинии тип линий может быть "вверх тормашками", причем реверс не помогает. Этот артефакт можно побороть, если в полилинии включить "генерацию типа линий".

Панели, лисп и инструкции здесь http://dwg.ru/dnl/607
Иконки для темной темы здесь
Обсуждаем, критикуем, предлагаем

Миниатюры
Нажмите на изображение для увеличения
Название: plrevers.jpg
Просмотров: 15347
Размер:	30.3 Кб
ID:	21079  


Последний раз редактировалось VVA, 08.09.2023 в 13:25. Причина: ссылка на иконки для темной темы
Просмотров: 367889
 
Непрочитано 12.10.2006, 16:18
#41
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 33
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Вроде бы все хорошо, но простите за назойливость, мне не нужно каждую вершину редактировать, а, переходя по полилинии корректировать некоторые из них, не выходя из команды.
Игорь Богаченко вне форума  
 
Непрочитано 12.10.2006, 16:21
#42
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 33
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Не досмотрел. Так устроит. Большое спасибо.
Игорь Богаченко вне форума  
 
Непрочитано 12.10.2006, 16:25
#43
Profan


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


Объясните, пожалуйста, а чем ручки-то плохи? Выделил полилинию и выбирай любую ручку, если нет ножки.
Profan вне форума  
 
Непрочитано 13.10.2006, 04:18
#44
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 33
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Этот код не вставляет вершину, а смещает. Это не подходит.
Если применять резинувую нить, то для двух смежных вершин, а не для одной с направлением. И, желательна свобода перемещения по редактируемой полилинии, а не быть привязаным к определенному участку, и двигаться по линии к следующему участку редактирования.
Лучше просто подсветить редактируемую линию, и вставлять вершины в нужных местах.
Игорь Богаченко вне форума  
 
Непрочитано 13.10.2006, 05:49
#45
Profan


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


Для VVA.
А это почему?
Код:
[Выделить все]
Команда: PL-VXMOVE

Укажите изменяемую вершину полилинии <выход>: ; ошибка: no function definition: 
LIB:IS-OBJECT-MODIFED

Команда:
Программа не может работать автономно?
Profan вне форума  
 
Автор темы   Непрочитано 13.10.2006, 09:15
#46
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Игорь Богаченко В № 38 писал
Цитата:
Возможность редактирования при включенных ручках - мне нравится. Будет включена во все команды по аналогу этой, то же и с undo.
PL-VxAdd с ручками уже готова, допишу отмену и выложу обновления. На этой (PL-VxMove) команде можно посмотреть как будет. Чуточку терпения.
Цитата:
Если применять резинувую нить, то для двух смежных вершин, а не для одной с направлением
В лиспе такое нельзя, по крайней мере я не знаю как.
Я тоже сомневаюсь в практической ценности PL-VxMove и согласен с Profan №43 Хотел написать на Profan №45
Цитата:
в №32 писал, здесь забыл Дополнительные ф-ции по ссылке с поста №1.
Но подправлю VVA №38, сделаю ф-цию автономной.
VVA вне форума  
 
Непрочитано 13.10.2006, 10:00
#47
Profan


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


Еще про ручки (такие, знаете ли, миленькие нежные ручки).
Подумавши, свою фразу построил бы по другому:
Выделил полилинию и выбирай любую ручку, если нет ножки, или выбирай с Shift'ом несколько ручек, если тебя привлекает групповуха. :twisted:
Profan вне форума  
 
Непрочитано 16.11.2006, 14:58
#48
Neznayka


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


Спасибо за прогу, но почему не добавляется вершина в полилинии с глобальной шириной, пишет ничего типа не выбранно, очень редко проскакивает. и в 2007 не пашет эта команда, чего-тот не хватает
Neznayka вне форума  
 
Автор темы   Непрочитано 16.11.2006, 17:58
#49
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пользуясь случаем обновил программы. Исправленные ошибки:
- PL-CLONE, PL-VxRdc Неточночть работы в UCS
- Добавлена команда PL-VX1 - Изменение начала полилинии
- В команду PL-VxMove добавлена опция:
Для 3d полилиний добавляется запрос сохранения Z узла полилинии
- CVPOLY переведена в режим командной строки.
- Вместо нее добавлена PL-3d2d (проецирование 3d на текущую ПСК)
- Entrevs - для замкнутых полилиний вершина остается на месте
- Корректная обработка кривизны и ширины замыкающего сенмента полилинии в ENTREVS
Особо хочу поблагодарить KAI за дельные замечания и советы.

> Neznayka Все добавляется. Просто размер прицела выбора (PICKBOX) должен быть больше текущей толщины полилинии на экране.
Варианта 2:
1. Либо зумом отъедь от полилинии
2. Либо в командной строке PICKBOX и увеличь значение.

Только что проверил: работает в 2007 RUS. Там чистый Лисп. От версии не должно зависеть.
VVA вне форума  
 
Непрочитано 21.11.2006, 11:07
#50
Neznayka


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


> Neznayka Все добавляется. Просто размер прицела выбора (PICKBOX) должен быть больше текущей толщины полилинии на экране.
Варианта 2:
1. Либо зумом отъедь от полилинии
2. Либо в командной строке PICKBOX и увеличь значение.

Только что проверил: работает в 2007 RUS. Там чистый Лисп. От версии не должно зависеть.[/quote]

Все понял , спасибо, поставил новую версию и в 2007 заработало почему-то :roll:

еще нашёл замечательное применение :
все время мучился с отрисовкой забора на своих схемах, теперь полилинию можно разбить на нужной длины сегмент, назначить
глобальную ширину, и переменную FILLMODE обнулить - все. а то я раньше всякие (мультилинии), выдумывал

вот только акад при разбивки секунд на 15 призадумывается, и это при том , что комп далеко не слабый у меня
[ATTACH]1164096458.GIF[/ATTACH]


а может еще такую фишку с геоникса добавить, типа есть замкнутый контур (здание обведено с растра, например) внутренние углы стремятся к 90 градусам, но у них это не получается из-за того не пользовались ф8 . Так вот щелкнул по линии и она трансформировалась в фигуру с углами в 90 гр. , за основу берется самая длиная сторона
возможно ли такое ?
Neznayka вне форума  
 
Автор темы   Непрочитано 21.11.2006, 17:04
#51
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Neznayka Тебе поможет эта команда. Несмотря на то, что речь идет о шпалах, можешь рисовать и заборы

Код:
[Выделить все]
(Defun C:RW ( /  ang col dH DL DLN e1 H_put i nev Param pt0 pt11 pt21
		S_spal Vobj *error* adoc Flg CL)
(defun *error* (msg)(vla-endundomark adoc)(setq PICK1 nil)(setvar "CLAYER" CL))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark adoc)
;;;H_put - ширина пути
;;;S_spal - шаг шпал
;;;DL- на сколько шпалы выступают за путь с одной стороны
  (setq	H_put 3 ;_ширина пути 3 мм
	S_spal 6 ;_шаг шпал 6 мм
	DL 0.5  ;выступают на 0.05 мм
  ) ;_ End of setq
  (setq Flg t)
  (while Flg
    (initget "S")
    (setq e1 (entsel "\nВыберите ось путей [настройки S] <выход>: "))
    (cond
      ((= e1 "S")
       (princ "\nШирина пути в мм <")(princ H_put)(princ "> : ")
       (initget 6)(setq pt0 (getdist))
       (if pt0 (setq H_put pt0)) ;_ End of if
       (princ "\nШаг шпал в мм <")(princ S_spal)(princ "> : ")
       (initget 6)(setq pt0 (getdist))
       (if pt0 (setq S_spal pt0)) ;_ End of if
       (princ "\nВыступ шпал в мм <")(princ DL)(princ "> : ")
       (initget 5)(setq pt0 (getdist))
       (if pt0 (setq DL pt0)) ;_ End of if
      )
      ((null e1)(if (= (getvar "ERRNO") 52)(setq Flg nil e1 nil vobj nil)(princ " *мимо*")))
      (t
       (setq e1 (car e1) vobj (vlax-ename->vla-object e1))
       (cond
	 ((null(vlax-write-enabled-p vobj))(alert "На блокированном слое!"))
	 ((wcmatch (cdr(assoc 0 (entget e1))) "LINE,ARC,SPLINE,*POLYLINE,ELLIPSE,CIRCLE")(setq Flg nil))
	 (t (alert (strcat "Объект " (cdr(assoc 0 (entget e1)))
	    " не может быть осью пути\nОсь пути - полилиния, линия, дуга, сплайн, эллиптическая дуга, круг"))))))
  ) ;_while 
(if vobj (progn
  (setq dH (+ (* H_put 0.5) DL)  
       DLN (vlax-curve-getDistAtParam vobj (vlax-curve-getEndParam vobj))
        col (fix (/ dln s_spal 1.0))
        nev (- DLN (* col S_spal))
        nev (* nev 0.5))
  (setq	PICK1 nil PICK1 (ssadd)) ;_ end of setq
  (setq CL (getvar "CLAYER"))(setvar "CLAYER" (vla-get-Layer vobj))
  (setq i '-1)
  (repeat (+ col 1)
    (setq i (1+ i))
    (setq pt0 (vlax-curve-getPointAtDist vobj (+ (* S_spal i) nev)))
    (setq param (vlax-curve-getParamAtPoint vobj pt0))
    (setq ang (vlax-curve-getFirstDeriv vobj param))
    (setq pt11 (mapcar '+ pt0 ang))
    (setq ang (angle pt0 pt11))
    (setq ang (- ang (* PI 0.5)))
    (setq pt11 (polar pt0 ang dH))
    (setq pt21 (polar pt0 (+ ang PI) dH))
    (vla-AddLine (vla-ObjectIDToObject adoc (vla-get-OwnerID vobj))
      (vlax-3d-point pt11)(vlax-3d-point pt21))
    (ssadd (entlast) PICK1)
  ) ;_ End of repeat
  (vla-Offset vobj (* H_put 0.5))(ssadd (entlast) PICK1)(vla-Offset vobj (- 0 (* H_put 0.5)))(ssadd (entlast) PICK1)
  (setq pt0 (mapcar '(lambda (x)(vlax-get-property vobj x)) '(Linetype LineWeight Color Layer)))
  (setq pt11 (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex PICK1)))))
  (mapcar '(lambda (vla)
	     (mapcar '(lambda (x y)(vlax-put-property vla x y))
		'(Linetype LineWeight Color Layer) pt0)) pt11)
  (setvar "CLAYER" CL)(command "_.-group" "_C" "*" "Трамвайные (ж.д.) пути" PICK1 "")
  (initget "Yes No")(if (= (getkword "\nУдалять ось путей? [Yes/No] <No> : ") "Yes")(vla-erase vobj))
    )
  )
(setq PICK1 nil)
(vla-endundomark adoc)
 (princ)
)
VVA вне форума  
 
Непрочитано 21.11.2006, 17:59
#52
Neznayka


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


интересно я это попробую , но для жд дороги , а заборы все-таки легче выше описанным, имхо
Neznayka вне форума  
 
Непрочитано 22.11.2006, 07:22
#53
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Совет программистам:

Для того, чтобы предотвратить ситуацию с неправильным указанием широкой (c физической шириной) полилинии, надо в функцию выбора примитива включать наподобие


Код:
[Выделить все]
 (setq om           (getvar "OSMODE")
          old_aperture (getvar "aperture")
 ) ;_ end of setq
 (setvar "OSMODE" 512)
 (setvar "aperture" (getvar "pickbox"))

;;..... здесь указание на примитив с обработкой правильности
(if (setq ent_selected
        (ru-get-entsel-by-type
                     msg
                     "Примитив недопустимого типа"
                     (list "LINE" "LWPOLYLINE")
                     t
                 ) 

        ) 
        (setq result (list (car ent_selected)
               (trans (osnap (trans (cadr ent_selected) 0 1) "_nea" 1 0)
                     ) 
        ) 
    )

;; Потом восстановление
(setvar "OSMODE" om)
(setvar "aperture" old_aperture)
Функция ru-get-entsel-by-type проверяет тип примитива, блокированность слоя и т.п. Не в ней дело (она вернет список как entsel), а в применении объектной привязки к полученной точке - функция osnap.
ShaggyDoc вне форума  
 
Автор темы   Непрочитано 22.11.2006, 13:25
#54
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>ShaggyDoc Спасибо, использовал.
>Neznayka
Цитата:
а может еще такую фишку с геоникса добавить, типа есть замкнутый контур (здание обведено с растра, например) внутренние углы стремятся к 90 градусам, но у них это не получается из-за того не пользовались ф8 . Так вот щелкнул по линии и она трансформировалась в фигуру с углами в 90 гр. , за основу берется самая длиная сторона
возможно ли такое ?
Пробуй
Код:
[Выделить все]
;;;Команда выравнивает внутренние углы полилинии до 90 градусов
;;;За основу берется самая длинная сторона
;;;
(Defun C:p90 ( / Flg e1 vobj i ang *error* crs pt0 pt1 pt2 pt3 var adoc)
(defun *error* (msg)(vla-endundomark adoc))
(defun pline-get-verts (pline_obj / verts)(setq verts (vlax-get pline_obj 'Coordinates)
      verts (cond ((wcmatch (vlax-get pline_obj 'Objectname ) "AcDb2dPolyline,AcDb3dPolyline")
             (group-by-num verts 3))
             ((eq (vlax-get pline_obj 'Objectname )"AcDbPolyline")(group-by-num verts 2))(T nil))))
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn
(setq ls nil)(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))(vla-startundomark adoc)
(setq Flg t)(while Flg (setq e1 (entsel "\nВыберите полилинию  <выход>: "))
    (cond ((null e1)(if (= (getvar "ERRNO") 52)(setq Flg nil e1 nil vobj nil)(princ " *мимо*")))
      (t (setq e1 (car e1) vobj (vlax-ename->vla-object e1))
       (cond ((null(vlax-write-enabled-p vobj))(alert "На блокированном слое!"))
	 ((wcmatch (cdr(assoc 0 (entget e1))) "*POLYLINE")(setq Flg nil))
	 (t (alert (strcat "Объект не полилиния"))))))) ;_while 
(if vobj (progn (setq crs (pline-get-verts vobj))(if (> (length crs) 2)(progn
(setq Pt1 nil pt2 nil ptS nil ptE nil var nil)(setq pt1 (car crs))
(mapcar'(lambda ( x )(if (or (null var)(< var (distance pt1 x)))
	   (setq var (distance pt1 x) ptS pt1 ptE x))(setq pt1 x))
 (cdr crs))(setq var nil i 0 lst crs)
(while i
  (if (and (equal (nth i crs) ptS 1e-6)(equal (nth (1+ i) crs) ptE 1e-6))
    (setq i nil)(setq var (append var (list (nth i crs))) i (1+ i) lst (cdr lst))))
(setq crs (append lst var))(setq ang (angle (car crs)(cadr crs)))
(setq lst (list (car crs)(cadr crs)) crs (cddr crs))
(foreach pt crs
  (setq pt1 (last lst)) (setq pt2 (polar pt ang 100))
  (setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))(setq pt0 (inters pt pt2 pt1 pt3 nil))
  (setq lst (append lst (list pt0)))(setq ang (angle pt1 pt0)))
(setq crs (reverse lst))(setq ang (angle (car lst)(cadr lst)))
(if (or (equal (angle (car crs)(cadr crs)) ang 1e-6)
	(equal (angle (car crs)(cadr crs))(+ ang PI) 1e-6)
	(equal (angle (car crs)(cadr crs))(- ang PI) 1e-6))
  (progn (setq pt1 (car lst))(setq pt0 (car crs))
    (setq pt2 (polar pt0 ang 100))(setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))
    (setq pt0 (inters pt0 pt2 pt1 pt3 nil))(setq lst (append (reverse(cdr crs))(list pt0)))
    (vla-put-Closed vobj :vlax-true))
  (progn (setq pt1 (car crs))(setq pt2 (cadr crs))
    (setq pt0 (inters (car lst)(cadr lst) pt1 pt2 nil))
    (if (and pt0 (equal (angle pt2 pt1)(angle pt2 pt0) 1e-6))
      (progn (setq pt1 (polar (car lst)(+ ang (* 0.5 PI)) 100))
	(setq pt0 (inters pt2 (polar pt2 ang 100)(car lst) pt1 nil))
	(setq crs (cddr crs))(setq crs (append (list pt0) crs))
	(setq lst (reverse crs))(vla-put-Closed vobj :vlax-true)))))
 (if (= (vla-get-ObjectName vobj) "AcDbPolyline")(setq lst (mapcar '(lambda (cr)(mapcar '+ cr '(0 0))) lst)))
  (setq crs (apply 'append lst))
  (setq var (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray
             vlax-vbDouble (cons 0 (1- (length crs)))) crs)))
(vla-put-Coordinates vobj var)))));_vobj
(vla-endundomark adoc)(princ))
(princ "\nНаберите в командной строке p90")

Последний раз редактировалось VVA, 19.09.2015 в 20:52.
VVA вне форума  
 
Непрочитано 22.11.2006, 14:13
#55
Lizzy

архитектор
 
Регистрация: 14.01.2006
Portugal, Sintra
Сообщений: 119


Извините, что вклиниваюсь в столь умную беседу со своей проблемой, в лиспах ничего не смыслю. Но вопрос касается свойств полилинии.

В одном файле после использования команды flatten objekts изменилось отбражение вновь проводимых полилиний. Толщина их стало отбражаться в абсолютных величинах, а не относительно экрана. мне удалось только выяснить, что это зависит от величин global width. Где можно это значение "обнулить"? Пока приходится делать это вручную в свойствах... :?:
__________________
жизнь-занятная штука...
Lizzy вне форума  
 
Непрочитано 22.11.2006, 14:46
#56
Neznayka


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


Вы кудесник, это так "окрасивит" мои чертежи,!!! прям сказка,

немогли бы вы на словах рассазать про алгоритм работы, это сравни уравновешивания теодолитного хода?
если Вас интересуют пожелания, то они такие:
некорректно работает с не замкнутой плинией (появляется короткий апендикс который совсем в другую сторону смотрит), и если можно ограничить выпрямляймые углы , скажем от 85 до 95 градусов, а то в зданиях бывают не только прямые углы, и еще чтоб скапом можно было контура обрабатывать, а не по одному.

ОГРОМНОЕ СПАСИБО
Neznayka вне форума  
 
Автор темы   Непрочитано 23.11.2006, 14:25
#57
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Lizzy Вручную в свойствах, только для всех полилиний сразу.
Выдели объекты, в окне свойств (там где Все) раскрой список, выбери полилинии. в поле Глобальная ширина вбей 0.
>Neznayka Пробуй. Про алгоритм чуть позже
Код:
[Выделить все]
;;;Команда выравнивает внутренние углы полилинии до 90+- допуск градусов
;;;За основу берется самая длинная сторона
;;;
(Defun C:p90 ( / Flg e1 i ang *error* crs pt0 pt1 pt2 pt3 var adoc dop1 dop2)
(defun *error* (msg)(princ msg)(vla-endundomark adoc))
(defun angw1w2 (Wekt1 Wekt2 $P000 / CosA)
(setq Wekt1 (mapcar '- Wekt1 $P000) Wekt2 (mapcar '- Wekt2 $P000) $P000 (mapcar '- $P000 $P000))
 (if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2))
  (distance $P000 Wekt1) (distance $P000 Wekt2))) -1.0 1e-6) Pi
  (if (equal CosA 0.0 1e-6) Pi2 (atan (sqrt (- 1 (* CosA CosA))) CosA))))
(defun pline-get-verts (pline_obj / verts)(setq verts (vlax-get pline_obj 'Coordinates)
      verts (cond ((wcmatch (vlax-get pline_obj 'Objectname ) "AcDb2dPolyline,AcDb3dPolyline")
             (group-by-num verts 3))
             ((eq (vlax-get pline_obj 'Objectname )"AcDbPolyline")(group-by-num verts 2))(T nil))))
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn
(setq ls nil)(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))(vla-startundomark adoc)
(setq ang (getangle "\nДопуск в градусах для выравнивания до 90 <любой угол>: "))
(if ang (setq dop1 (- (* 0.5 PI) ang) dop2  (+ (* 0.5 PI) ang))
(setq dop1 nil dop2 nil))
(princ "\nВыберите полилинии ")(setq selset (ssget "_:L" '((0 . "*POLYLINE"))))
(if selset (progn (setq selset (mapcar 'vlax-ename->vla-object  (vl-remove-if 'listp
 (mapcar 'cadr (ssnamex selset)))))
 (mapcar '(lambda(vobj / ug ptS ptE)(setq crs (pline-get-verts vobj))
    (if	(> (length crs) 2)(progn (setq Pt1 nil pt2 nil ptS nil ptE nil var nil)
	(setq pt1 (car crs))(mapcar '(lambda (x)(if (or (null var) (< var (distance pt1 x)))
        (setq var (distance pt1 x) ptS pt1 ptE x))  (setq pt1 x))(cdr crs))(setq i 0 var 0)
	(while (and i (nth i crs))(if (and (equal (nth i crs) ptS 1e-6)
               (equal (nth (1+ i) crs) ptE 1e-6))(setq var (1+ i) i (+ (length crs) 1)))
	    (setq i (1+ i)))
	(if (> var (* 0.5 (length crs)))(setq crs (reverse crs) i ptS ptS ptE ptE i))
	(setq var nil i 0 lst crs)
	(while (and i (nth i crs))
	  (if (and (equal (nth i crs) ptS 1e-6)(equal (nth (1+ i) crs) ptE 1e-6))
	    (setq i nil)(setq var (append var (list (nth i crs)))
		  i   (1+ i) lst (cdr lst))))
	(setq crs (append lst var))(setq ang (angle (car crs) (cadr crs)))
	(setq lst (list (car crs) (cadr crs)) crs (cddr crs))
	(foreach pt crs (setq pt1 (last lst))
	  (setq pt2 (polar pt ang 100))(setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))
	  (setq ug (angw1w2 pt (cadr (reverse lst)) pt1))
	  (if (or (null dop1)(and (> ug dop1)(< ug dop2)))
	    (setq pt0 (inters pt pt2 pt1 pt3 nil))(setq pt0 pt))
	  (setq lst (append lst (list pt0)))(setq ang (angle pt1 pt0)))
	(setq crs (reverse lst))(setq ang (angle (car lst) (cadr lst)))
	(if (or	(equal (angle (car crs) (cadr crs)) ang 1e-6)
		(equal (angle (car crs) (cadr crs)) (+ ang PI) 1e-6)
		(equal (angle (car crs) (cadr crs)) (- ang PI) 1e-6))
	  (progn (setq pt1 (car lst))(setq pt0 (car crs))(setq pt2 (polar pt0 ang 100))
		 (setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))(setq pt0 (inters pt0 pt2 pt1 pt3 nil))
		 (setq lst (append (reverse (cdr crs)) (list pt0)))
		 (vla-put-Closed vobj :vlax-true))
	  (progn (setq pt1 (car crs))(setq pt2 (cadr crs))
	    (setq pt0 (inters (car lst) (cadr lst) pt1 pt2 nil))
	    (if	(and pt0 (equal (angle pt2 pt1) (angle pt2 pt0) 1e-6))
	      (progn (setq pt1 (polar (car lst) (+ ang (* 0.5 PI)) 100))
		     (setq pt0 (inters pt2 (polar pt2 ang 100) (car lst) pt1 nil))
		     (setq crs (cddr crs))(setq crs (append (list pt0) crs))
		     (setq lst (reverse crs))(vla-put-Closed vobj :vlax-true)))))
	(if (= (vla-get-ObjectName vobj) "AcDbPolyline")
	  (setq lst (mapcar '(lambda (cr) (mapcar '+ cr '(0 0))) lst)))
	(setq crs (apply 'append lst))(setq var (vlax-make-variant (vlax-safearray-fill
        (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length crs)))) crs)))
	(vla-put-Coordinates vobj var)))) selset))) ;_selset
(vla-endundomark adoc)(princ))(princ "\nНаберите в командной строке p90")
Если в ответ на запрос
Цитата:
Допуск в градусах для выравнивания до 90 <любой угол>:
ввести 5, то будут обрабатываться углы 85-95 градусов

Последний раз редактировалось VVA, 19.09.2015 в 20:55.
VVA вне форума  
 
Непрочитано 24.11.2006, 13:41
#58
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Комментарий к программе PL-VxRdc (прополка полилинии):

работаю с lwpolyline
она имеет свойство Замкнута

программа выдает ошибку
Код:
[Выделить все]
Command: PL-VxRdc
25 found

Command:
Введите max отклонение от прямой (H) [угловой допуск A/отклонение H] <0.15>:
ERRNO # 0: Automation Error. Invalid index

Command: *Cancel*
Снимаю атрибут Замкнута.
Программа работает корректно.
Кочетков Андрей вне форума  
 
Автор темы   Непрочитано 24.11.2006, 14:32
#59
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Спасибо проверю
VVA вне форума  
 
Автор темы   Непрочитано 24.11.2006, 16:30
#60
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Кочетков Андрей Исправил. Выложил в download
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

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

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