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

Вернуться   Форум 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
 
Непрочитано 17.03.2009, 15:37
#181
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, а вот скажи, 3D полилинию в сплайн переделывать надо? В смысле с радиусами в вершинах? Я тут сплайны расковырял и в принципе уже могу и дуги и прямолинейные участки делать через entmake сплайнами. Погрешность очень не велика и ее можно сокращать увеличением количества точек на дугах. Вот сижу и ломаю голову, надо это, или не надо.
Supermax вне форума  
 
Непрочитано 17.03.2009, 15:51
#182
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Вообще-то конвертация полилинии в сплайн решает задачу сглаживания, но сколько я не глядел как отцы подходят к этой задаче, они получают точки как для сплайна а потом по ним все равно полилиния делается видимо обосновано простотой примитивов.
Sleekka вне форума  
 
Автор темы   Непрочитано 17.03.2009, 17:58
#183
VVA

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


Supermax, Это у народа нужно спрашивать. Но раз ты расковырял сплайн, то может будет интересна еще и задача апроксимации сплайна полилинией с дуговыми сегментами.
Sleekka, Да, сплайн "тяжелый" для Автокада примитив.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 17.03.2009, 18:06
#184
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 4,811
Отправить сообщение для Cfytrr с помощью Skype™


Извиняюсь, но можно ли подправить работу в AutoCad 2009 64х(описанние в #174)
__________________
...переменная FILEDIA создана для привлечения пользователей к форумам.
Cfytrr вне форума  
 
Автор темы   Непрочитано 17.03.2009, 19:28
#185
VVA

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


Cfytrr, Скоро на работе поставят поставят Висту 64 для ананализа работоспособности наших программ по ней. Тогда посмотрю в чем там дело.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.03.2009, 10:39
#186
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, перевести сплайн в 3D полилинию можно, поскольку имея представление как строится сплайн Автокадом, можно высчитать ряд точек и провести но ним 3D полилинию, но вот имея ряд точек, определить нужна ли там дуга или нет? - Так можно на каждые три точки, которые не лежат на одной прямой дуги лепить.
Короче, с дугами затык.
Потом, сплайн очень коварная штука. В любой момент может выскочить "холмик", который можно описать только очень большим количеством точек, а все остальное может быть просто прямой.

Но, мне кажеться, я где-то уже видел такую прогу.
Supermax вне форума  
 
Непрочитано 29.03.2009, 21:06
#187
Денис Флюстиков


 
Регистрация: 20.07.2005
СПб
Сообщений: 89


VVA,

Программа получения полилиний с дуговыми сегментами при выборе сплайнов или эллипсов. Правда, особо не гонял.
Вложения
Тип файла: rar To_pline_Den.rar (4.6 Кб, 141 просмотров)
Денис Флюстиков вне форума  
 
Автор темы   Непрочитано 29.03.2009, 22:04
#188
VVA

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


Денис Флюстиков, Спасибо, посмотрю.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.03.2009, 12:34
#189
Денис Флюстиков


 
Регистрация: 20.07.2005
СПб
Сообщений: 89


VVA,
Тестирование программы из поста #187, показало, что для более корректной работы необходимо заменить строчку:
z6 (sin (- (angle (nth (1- z3) z2)(nth z3 z2))
на:
z6 (sin (- (angle (nth (cadr z4) z2)(nth z3 z2))
Денис Флюстиков вне форума  
 
Непрочитано 31.03.2009, 23:46
#190
Neznayka


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


Сложный прямоугольник
Может это под автокад возможно заточить:
« При создании объекта способом "Сложный прямоугольник" вначале вводятся две точки - самая длинная боковая сторона создаваемого объекта, а затем - остальные вершины прямоугольника (через одну). Точки указываются на экране курсором и вводятся нажатием левой кнопки мыши. Промежуточные точки создаются автоматически на пересечении прямой, параллельной первой линии (и проходящей через текущую точку) и перпендикуляра к первой линии, проходящего через предыдущую точку. Таким образом, перпендикулярность всех граней создаваемого объекта (в том числе и последней, замыкающей) отслеживается автоматически.»
Я так и не понял, как замыкать этот прямоугольник, вероятно после клика №4 должен следовать правый клик, который задаёт удаление грани «А» от первоначальной грани
Миниатюры
Нажмите на изображение для увеличения
Название: сложный_прямо.gif
Просмотров: 140
Размер:	3.0 Кб
ID:	18163  
Neznayka вне форума  
 
Автор темы   Непрочитано 01.04.2009, 10:19
#191
VVA

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


Neznayka,
Цитата:
вероятно после клика №4 должен следовать правый клик, который задаёт удаление грани «А» от первоначальной грани
По мне так не хватает точки 5 на перечении линии А и перпендикуляра к 1. Можно сделать как в команде Облако (_revcloud)ю Там команда завершается, кодга мышкой придешь в исходную точку. А здесь отслеживать , что при указании точки (в данном случае 5) перпендикуляр от нее попадает в точку 1 с некоторым допуском.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.04.2009, 12:51
#192
Neznayka


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


C точкой 5 имхо плохо, т.к точности не будет (ну если только объектное отслеживание включить).
По принципу "облака" то же хорошо, но будет лишний клик (по т.1) и точка 5 будет "плавать", т.е. её привязкой точно не посадишь, ведь точка 5 все равно будет на перпендикуляре к стороне 1-2. Я чётко излагаю или надо детальный чертеж в районе т.5.
Надо реализовать вариант незамкнутости, и что делать с методом т.5 если надо чтоб продолжить полилинию за грань 1-5, т.е полигон будет с самопересечением (это для тех кто не только домики рисует)
И самый главный вопрос: ВОЗЬМЁТЕСЬ за это?
Neznayka вне форума  
 
Непрочитано 01.04.2009, 14:06
#193
zamtmn

КИПиА
 
Регистрация: 21.03.2005
Tyumen
Сообщений: 1,352
<phrase 1=


Хороший набор команд. но ENTREVS теряет расширенные данные полилинии, это сложно поправить?
zamtmn вне форума  
 
Автор темы   Непрочитано 01.04.2009, 15:24
#194
VVA

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


zamtmn, Уже исправил. Постараюсь на днях выложить новую версию.
Neznayka, Буду думать
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 02.04.2009, 15:55
#195
VVA

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


Neznayka, В качестве первого приближения
Код:
[Выделить все]
;_Dificult RECtangle
(defun C:DREC ( / *error* ss BasePt1 BasePt2 tmp  ang0 ang90 CurrentPt LastPt U_M usr_list eLast)
  (vl-load-com)
  (defun *error* (msg / )
    (while (> (getvar "CMDACTIVE") 0)(command))
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
    (princ msg)
    (if elast
    (progn
      (setq ss nil ss (ssadd))
      (while (setq eLast (entnext eLast)) (ssadd eLast ss))
      (if (= (sslength ss) 0);_ Пустой набор
	(setq ss nil)
	)
      )
    )
  (if ss (command "_.ERASE" ss ""))
     (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    )
    (princ)
    )
  (setq usr_list (mapcar '(lambda (x) (cons x (getvar x)))
    '("USERR1"  "USERR2"))
  )
    (vla-StartUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  )
  ;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) ;_ Отключено UNDO
     (command "_.UNDO" "_All")
     )
    ((= (logand U_M 3) 3) ;_ Разрешена отмена одной операции
     (command "_.UNDO" "_Control" "_All") 
     )
    (t nil)
  ) ;_ end of cond
    (setq U_M 0) ;_VVA Устанавливаем счетчик отмен UNDO
  ;;; Запоминаем в eLast последний примитив 
    (if (null (setq eLast (entlast)))
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
      (setq eLast (entlast))
      (entdel eLast)
      )
    )

  (initget 1)(setq BasePt1 (getpoint "\nПервая базовая точка: "))
  (initget 1)(setq BasePt2 (getpoint BasePt1 "\nВторая базовая точка: "))
  (setq ang0 (angle BasePt1 BasePt2))
  (setq ang90 (+ ang0 (* 0.5 PI)))
  (setq LastPt BasePt2)
  (command "_LINE" "_non" BasePt1 "_non" BasePt2 "")
  (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
  (while (and (setq CurrentPt (getpoint "\nВершина прямоугольника [Отмени/Замкни] <замкни>: "))
	      (setq CurrentPt (if (= CurrentPt "Close") nil CurrentPt))
	      )
    (cond ((listp CurrentPt)
    (setq tmp (inters CurrentPt
		      (polar CurrentPt ang0 100)
		      LastPt
		      (polar LastPt ang90 100)
		      nil
		      )
	  )
    (if tmp
      (progn
        (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
        (setvar "USERR2" (cadr LastPt));_Запоминаем Y точки
        (command "_.UNDO" "_M") ;_Ставим метку UNDO 
	(command "_LINE" "_non" LastPt "_non" tmp "_non" CurrentPt "")
	(setq LastPt CurrentPt)
	(setq U_M (1+ U_M))
	)
      )
    )
((= CurrentPt "Undo")
      (if (> U_M 0) ;_ Если есть что отменять 
        (progn
   (command "_.UNDO" "_B")
   (setq U_M (1- U_M))
   (setq LastPt (list (getvar "USERR1") (getvar "USERR2")))
   (setvar "LASTPOINT" LastPt)
        )
        (alert "Отменять больше нечего")
      )
     )
	   )
    (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
    )
  (initget 1)(setq CurrentPt (getpoint "\nТочка удаления замыкающей грани: "))
  (if (and
	(setq tmp (inters CurrentPt
		      (polar CurrentPt ang0 100)
		      LastPt
		      (polar LastPt ang90 100)
		      nil
		      )
	  )
	(setq CurrentPt tmp)
	(setq tmp (inters CurrentPt
		      (polar CurrentPt ang0 100)
		      BasePt1
		      (polar BasePt1 ang90 100)
		      nil
		      )
	  )
	)
    (progn
      	(command "_LINE" "_non" LastPt "_non" CurrentPt "")
      	(command "_LINE" "_non"  CurrentPt  "_non" tmp "")
      	(command "_LINE" "_non"  tmp  "_non" BasePt1 "")
      )
    )
  (if elast
    (progn
      (setq ss nil ss (ssadd))
      (while (setq eLast (entnext eLast)) (ssadd eLast ss))
      (if (= (sslength ss) 0);_ Пустой набор
	(setq ss nil)
	)
      )
    )
  (if ss
    (progn
      (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
	(command "_pedit" "_Multiple" ss "" "_Join" 0 "")
	(command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
	)
      (setq ss nil)
      )
    )
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
  (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    )
  (princ)
 )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.04.2009, 21:44
#196
Neznayka


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


Ура!!! Вот счастье-то какое.
Пока оттестировать досконально нечем, серьёзных замечаний я не вижу, так только по мелочи:

1. Нажатие на esc во время выполнения команды УДАЛЯЕТ ВСЕ ранее созданное. А не прерывает команду.
2. Очень желательно чтоб во время отрисовки перекрестье было временно повернуто согласно грани 1-2.
3. Не помешало бы видеть саму полилинию во время создания «колена», а не наблюдать её появления как свершившийся факт после клика.
4. Почему Вы решили, что замыкание по нажатию на пробел более удобно чем просто правый клик, если потому что реализовать программно правый клик труднее, то у меня вопросов нет. Впрочем правый клик это на любителя

Последний раз редактировалось Neznayka, 02.04.2009 в 22:27.
Neznayka вне форума  
 
Автор темы   Непрочитано 03.04.2009, 10:53
#197
VVA

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


Цитата:
Сообщение от Neznayka Посмотреть сообщение
Ура!!! Вот счастье-то какое.
Пока оттестировать досконально нечем, серьёзных замечаний я не вижу, так только по мелочи:

1. Нажатие на esc во время выполнения команды УДАЛЯЕТ ВСЕ ранее созданное. А не прерывает команду.
Да, так было и задумано, но можно передумать. Надо?
2. Очень желательно чтоб во время отрисовки перекрестье было временно повернуто согласно грани 1-2.
Это можно попробывать
3. Не помешало бы видеть саму полилинию во время создания «колена», а не наблюдать её появления как свершившийся факт после клика.
Это сложнее. Не обещаю.
4. Почему Вы решили, что замыкание по нажатию на пробел более удобно чем просто правый клик, если потому что реализовать программно правый клик труднее, то у меня вопросов нет. Впрочем правый клик это на любителя
"Дерусь, потому что просто дерусь" © Портос. Я решил что так удобнее. Но можно передумать. Надо?
Кстати правый клик тоже обрабатыватся. И что делать тогда по нажатию на пробел.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2009, 12:21
#198
Neznayka


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


ЕСЛИ ЭТО НЕ трудозатратно, то, пожалуйста. На пробел - завершение команды на том, где мы остановились и запуск команды по-новому.
Neznayka вне форума  
 
Автор темы   Непрочитано 03.04.2009, 14:08
#199
VVA

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


Вариант 2
Код:
[Выделить все]
 ;_Dificult RECtangle
(defun C:DREC (/	*error*	 ss	  BasePt1  BasePt2  tmp
	       ang0	ang90	 CurrentPt	   LastPt   U_M
	       usr_list	eLast
	      )
  (vl-load-com)
  (defun *error* (msg /)
    (while (> (getvar "CMDACTIVE") 0) (command))
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
    (princ msg)
    (if	elast
      (progn
	(setq ss nil
	      ss (ssadd)
	) ;_ end of setq
	(while (setq eLast (entnext eLast)) (ssadd eLast ss))
	(if (= (sslength ss) 0) ;_ Пустой набор
	  (setq ss nil)
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
;;;  (if ss (command "_.ERASE" ss ""))
    (if	(and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
      (command "_pedit" "_Multiple" ss "" "_Join" 0 "")
      (command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
    ) ;_ end of if
    (setq ss nil)
    (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-EndUndoMark
    (princ)
  ) ;_ end of defun
  (setq	usr_list (mapcar '(lambda (x) (cons x (getvar x)))
			 '("USERR1" "USERR2")
		 ) ;_ end of mapcar
  ) ;_ end of setq
  (vla-StartUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-StartUndoMark
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) ;_ Отключено UNDO
     (command "_.UNDO" "_All")
    )
    ((= (logand U_M 3) 3) ;_ Разрешена отмена одной операции
     (command "_.UNDO" "_Control" "_All")
    )
    (t nil)
  ) ;_ end of cond
;;; Запоминаем в eLast последний примитив 
  (if (null (setq eLast (entlast)))
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
	   (setq eLast (entlast))
	   (entdel eLast)
    ) ;_ end of progn
  ) ;_ end of if
  (while
    (and (setq U_M 0) ;_VVA Устанавливаем счетчик отмен UNDO
	 (setq BasePt1 (getpoint "\nПервая базовая точка <выход>: "))
    ) ;_ end of and
     (initget 1)
     (setq BasePt2 (getpoint BasePt1 "\nВторая базовая точка: "))
     (setq ang0 (angle BasePt1 BasePt2))
     (setq ang90 (+ ang0 (* 0.5 PI)))
     (setq LastPt BasePt2)
     (command "_LINE" "_non" BasePt1 "_non" BasePt2 "")
     (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
     (while (and (setq CurrentPt
			(getpoint
			  "\nВершина прямоугольника [Отмени/Замкни] <выход>: "
			) ;_ end of getpoint
		 ) ;_ end of setq
		 (/= CurrentPt "Close")
	    ) ;_ end of and
       (cond
	 ((listp CurrentPt)
	  (setq	tmp (inters CurrentPt
			    (polar CurrentPt ang0 100)
			    LastPt
			    (polar LastPt ang90 100)
			    nil
		    ) ;_ end of inters
	  ) ;_ end of setq
	  (if tmp
	    (progn
	      (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
	      (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
	      (command "_.UNDO" "_M") ;_Ставим метку UNDO 
	      (command "_LINE"	 "_non"	   LastPt    "_non"
		       tmp	 "_non"	   CurrentPt ""
		      ) ;_ end of command
	      (setq LastPt CurrentPt)
	      (setq U_M (1+ U_M))
	    ) ;_ end of progn
	  ) ;_ end of if
	 )
	 ((= CurrentPt "Undo")
	  (if (> U_M 0) ;_ Если есть что отменять 
	    (progn
	      (command "_.UNDO" "_B")
	      (setq U_M (1- U_M))
	      (setq LastPt (list (getvar "USERR1") (getvar "USERR2")))
	      (setvar "LASTPOINT" LastPt)
	    ) ;_ end of progn
	    (alert "Отменять больше нечего")
	  ) ;_ end of if
	 )
       ) ;_ end of cond
       (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
     ) ;_ end of while
     (if (= CurrentPt "Close")
       (progn
	 (initget 1)
	 (setq
	   CurrentPt (getpoint "\nТочка удаления замыкающей грани: ")
	 ) ;_ end of setq
	 (if (and
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 LastPt
				 (polar LastPt ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	       (setq CurrentPt tmp)
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 BasePt1
				 (polar BasePt1 ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	     ) ;_ end of and
	   (progn
	     (command "_LINE" "_non" LastPt "_non" CurrentPt "")
	     (command "_LINE" "_non" CurrentPt "_non" tmp "")
	     (command "_LINE" "_non" tmp "_non" BasePt1 "")
	   ) ;_ end of progn
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (setq ss nil)
     (if elast
       (progn
	 (setq ss nil
	       ss (ssadd)
	 ) ;_ end of setq
	 (while (setq eLast (entnext eLast)) (ssadd eLast ss))
	 (if (= (sslength ss) 0) ;_ Пустой набор
	   (setq ss nil)
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (if ss
       (progn
	 (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
	   (command "_pedit" "_Multiple" ss "" "_Join" 0 "")
	   (command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
	 ) ;_ end of if
	 (setq ss nil)
       ) ;_ end of progn
     ) ;_ end of if
     (setq eLast (entlast))
  ) ;_ end of while
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
  (vla-EndUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
  (princ)
) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2009, 16:22
#200
Neznayka


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


стало хуже: по правому клику появляется контектное меню и в нём надо выбрать ЗАМКНИ, тогда только можно замкнуть прямоугольник.Необходимо блокировать контекстное меню и правый клик должен сразу активировать ЗАМКНИ
Neznayka вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

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

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