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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Адаптация программы под AutoCad 2015

Адаптация программы под AutoCad 2015

Ответ
Поиск в этой теме
Непрочитано 01.11.2014, 15:35 #1
Адаптация программы под AutoCad 2015
Maxxwell
 
Регистрация: 25.08.2009
Сообщений: 50

Доброго времени суток, может не в тему, но лучше ничего не придумал, как обратиться к уважаемому сообществу. Есть весьма полезная прога по автонумерации, на которую ее автор похоже забил всерьез и с концами, сколько не искал, удобней программы не смог найти, был бы весьма благодарен, еслиб кто-нибудь смог адаптировать ее под AutoCad 2015. Вот собственно сама прога http://dwg.ru/dnl/515
Просмотров: 7099
 
Непрочитано 03.11.2014, 00:28
#2
Andrey_nadym


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


Я вот этим пользуюсь
Код:
[Выделить все]
 ;=======================================================================================================================
; Лисп для нумерации блоков оборудования ЭСБ в порядке указания, в заданном формате.
;=======================================================================================================================
(defun c:numer (/
			DimzinValue
			RepearProcess RepeatProcess1 RepeatProcess2
			BlockEntName AttrEntName
			ValidAttrib
			StartNumber NumberReply
			ChangeList NumToChange NumAfterChange
			CharPart
			PointPos
			TxtDigCounter DigCounter TxtDigCounterNew
			Multip
		       )
(command "_Undo" "_Begin")
(setq DimzinValue (getvar "Dimzin")); Сохранение значения переменной Dimzin
(setvar "Dimzin" 0); Установка переменной Dimzin на ноль, чтобы исключить "срезание" нулей в номере блока и неверную работу функции (/)
(setq RepeatProcess T); Задание начального значения признака выхода из цикла
(while RepeatProcess; Начало цикла выбора объекта
  (setq BlockEntName (car (entsel "\nУкажите первый блок <выход>: ")))
  (if BlockEntName
    (progn
      (if (= (cdr (assoc 0 (entget BlockEntName))) "INSERT")
	(progn
          (if (not (not (entnext BlockEntname)))
	    (progn
	      (if (= (cdr (assoc 0 (entget (entnext BlockEntName)))) "ATTRIB")
	        (progn
	          (setq AttrEntName (cdr (assoc -1 (entget (entnext BlockEntName)))))
	          (setq RepeatProcess1 T)
	          (setq ValidAttrib nil)
	          (while RepeatProcess1
		    (if (= (cdr (assoc 2 (entget AttrEntName))) "NUM_DEVICE")
		      (progn
		        (setq RepeatProcess1 nil)
		        (setq RepeatProcess nil)
		        (setq ValidAttrib T)
		      ); progn
		      (progn
		        (setq AttrEntName (cdr (assoc -1 (entget (entnext AttrEntName)))))
		        (if (not (= (cdr (assoc 0 (entget AttrEntName))) "ATTRIB"))
		          (setq RepeatProcess1 nil)
		        ); if
		      ); progn
		    ); if
	          ); while
	          (if (not ValidAttrib)
		    (princ "\nВыбранный блок не имеет нужного атрибута")
	          ); if
	        ); progn
	        (princ "\nВыбранный блок не имеет атрибутов")
	      ); if
	    ); progn
	    (princ "\nВыбранный блок не имеет атрибутов")
	  ); if
	); progn
	(princ "\nВыбранный объект не является блоком")
      ); if
    ); progn
    (if (= (getvar "ERRNO") 52) (progn (setvar "DIMZIN" DimzinValue) (command "_Undo" "_End") (exit)))
  ); while
); Конец цикла выбора объекта
(setq StartNumber (vl-string-trim " " (vl-string-trim (vl-symbol-name (read (cdr (assoc 1 (entget AttrEntName))))) (cdr (assoc 1 (entget AttrEntName)))))); Присвоение изменяемой числовой части обозначения блока значения в соответствии с первым указанным блоком
(setq RepeatProcess T); Задание начального значения признака выхода из цикла
(while RepeatProcess; Начало цикла запроса начального значения номера прибора
  (setq NumberReply (getstring (strcat "\nВведите начальное значение номера прибора (" StartNumber "): ")))
  (if (= NumberReply ""); Начало проверки ввода начального номера
    (setq RepeatProcess nil); Действия, выполняемые при пустом вводе
    (progn; Начало действий, выполняемых при непустом вводе
      (if (wcmatch NumberReply "*[~1234567890.]*"); Начало проверки на наличие недопустимых символов
	(princ "\nПри вводе допустимы только цифры и символ точки "); Действия при наличии недопустимых символов во вводе
	(progn; Начало действий при отсутствии недопустимых символов во вводе
	  (setq StartNumber NumberReply)
	  (setq RepeatProcess nil)
	); Конец действий при отсутствии недопустимых символов во вводе
      ); Конец проверки на наличие недопустимых символов
    ); Конец действий, выполняемых при непустом вводе
  ); Конец проверки ввода начального номера
); Конец цикла запроса начального значения номера прибора
(setq RepeatProcess T); Задание начального значения признака выхода из цикла
(while RepeatProcess; Начало цикла изменения нумерации блоков
  (setq ChangeList (entget AttrEntName)); Извлечение списка свойств атрибута
  (setq NumToChange (cdr (assoc 1 ChangeList))); Извлечение значения первого атрибута
  (setq CharPart (vl-symbol-name (read NumToChange))); Извлечение текстовой части значения первого атрибута
  (setq NumAfterChange (strcat CharPart " " StartNumber))
  (entmod (subst (cons 1 NumAfterChange) (cons 1 NumToChange) ChangeList)); Изменение DXF кода изменяемого атрибута
  (entupd AttrEntName); Обновление атрибута в базе данных чертежа (и на экране, есссно...)
  ;(setq AttrEntName (entnext (car (entsel))))
  (setq RepeatProcess1 T); Задание начального значения признака выхода из цикла
  (while RepeatProcess1; Начало цикла выбора объекта
  (setq BlockEntName (car (entsel "\nУкажите следующий блок <выход>: ")))
  (if BlockEntName
    (progn
      (if (= (cdr (assoc 0 (entget BlockEntName))) "INSERT")
	(progn
          (if (not (not (entnext BlockEntname)))
	    (progn
	      (if (= (cdr (assoc 0 (entget (entnext BlockEntName)))) "ATTRIB")
	        (progn
	          (setq AttrEntName (cdr (assoc -1 (entget (entnext BlockEntName)))))
	          (setq RepeatProcess2 T)
	          (setq ValidAttrib nil)
	          (while RepeatProcess2
		    (if (= (cdr (assoc 2 (entget AttrEntName))) "NUM_DEVICE")
		      (progn
		        (setq RepeatProcess2 nil)
		        (setq RepeatProcess1 nil)
		        (setq ValidAttrib T)
		      ); progn
		      (progn
		        (setq AttrEntName (cdr (assoc -1 (entget (entnext AttrEntName)))))
		        (if (not (= (cdr (assoc 0 (entget AttrEntName))) "ATTRIB"))
		          (setq RepeatProcess2 nil)
		        ); if
		      ); progn
		    ); if
	          ); while
	          (if (not ValidAttrib)
		    (princ "\nВыбранный блок не имеет нужного атрибута")
	          ); if
	        ); progn
	        (princ "\nВыбранный блок не имеет атрибутов")
	      ); if
	    ); progn
	    (princ "\nВыбранный блок не имеет атрибутов")
	  ); if
	); progn
	(princ "\nВыбранный объект не является блоком")
      ); if
    ); progn
    (if (= (getvar "ERRNO") 52) (progn (setvar "DIMZIN" DimzinValue) (command "_Undo" "_End") (exit)))
  ); while
); Конец цикла выбора объекта
  (setq PointPos (vl-string-position 46 StartNumber 0 T))
  (if PointPos
    (setq TxtDigCounter (substr StartNumber (+ PointPos 2)))
    (setq TxtDigCounter StartNumber)
  ); if
  ;(setq TxtDigCounter (substr StartNumber (+ (vl-string-position 46 StartNumber 0 T) 2)))
  (setq DigCounter (+ (atof TxtDigCounter) 1))
  (setq Multip (atof (vl-string-subst "" "." (rtos 1 2 (strlen TxtDigCounter)))))
  (setq TxtDigCounterNew (substr (rtos (/ DigCounter Multip) 2 (strlen TxtDigCounter)) 3))
  (setq StartNumber (vl-string-subst TxtDigCounterNew TxtDigCounter StartNumber (vl-string-position 46 StartNumber 0 T)))
); Конец цикла изменения нумерации блоков
(command "_Undo" "_End")
(setvar "Dimzin" DimzinValue); Возврат переменной Dimzin её первоначального значения
); defun
Andrey_nadym вне форума  
 
Непрочитано 03.11.2014, 01:23
#3
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


http://dwg.ru/dnl/1929
Nike вне форума  
 
Непрочитано 03.11.2014, 06:25
#4
roaa

ОПС
 
Регистрация: 29.03.2012
Kazakhstan
Сообщений: 128


ну и до кучи
http://lee-mac.com/numinc.html
roaa вне форума  
 
Автор темы   Непрочитано 04.11.2014, 00:42
#5
Maxxwell


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


Всем огромное спасибо, буду тестить!
Maxxwell вне форума  
 
Непрочитано 04.11.2014, 21:17
#6
Andrey_nadym


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


Думаю надо сделать отдельный раздел или тему в разделе "готовые программы" на форуме "НУМЕРАТОРЫ" и там делиться готовыми программами по нумерации и перенумерации блоков, текстов и т.д.
Andrey_nadym вне форума  
 
Непрочитано 04.11.2014, 21:31
#7
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


А что знатоков VBA не осталось? Тема-то не раз обсуждалась, как перепилить старый VBA на новый лад...
gomer вне форума  
 
Непрочитано 05.11.2014, 00:31
#8
Andrey_nadym


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


ув. gomer Вы случаем не про это говорите
Цитата:
Сообщение от gomer Посмотреть сообщение
как перепилить старый VBA на новый лад..
http://download.autodesk.com/media/a...s_Russian.html
Andrey_nadym вне форума  
 
Непрочитано 05.11.2014, 00:52
#9
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


Цитата:
Сообщение от gomer Посмотреть сообщение
А что знатоков VBA не осталось? Тема-то не раз обсуждалась, как перепилить старый VBA на новый лад...
"Понял, не дурак. Был бы дурак - не понял бы."
Лучше помог бы людям, вместо того чтоб языком трепать. "Знаток".
Nike вне форума  
 
Непрочитано 05.11.2014, 01:51
#10
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от Nike Посмотреть сообщение
Лучше помог бы людям
Купишь мне 2015, сделаю людям бесплатно
gomer вне форума  
 
Непрочитано 05.11.2014, 02:56
#11
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


gomer, портной без порток.
Nike вне форума  
 
Непрочитано 05.11.2014, 07:33
#12
shifr


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


Цитата:
Купишь мне 2015
и сразу
Цитата:
как перепилить старый VBA на новый лад...
Чисто философский....А надо...2015?... Если платят не за перепиливание
shifr вне форума  
 
Непрочитано 05.11.2014, 08:23
#13
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от Andrey_nadym Посмотреть сообщение
Вы случаем не про это говорите
Скорей про это - http://forum.dwg.ru/showthread.php?t=104430
Цитата:
Сообщение от shifr Посмотреть сообщение
Чисто философский...
Я не шью на VBA чисто по эстетическим соображениям, а за перешивание беру больше, чем за вышивание
gomer вне форума  
 
Непрочитано 05.11.2014, 13:12
#14
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,405
Отправить сообщение для Александр Ривилис с помощью Skype™


Проверил программу в AutoCAD 2015 SP2 x64 - на первый взгляд работает нормально. Сразу возник вопрос. А установлен ли у вопрошающего AutoCAD 2015 VBA Module?
На всякий случай где его искать: http://knowledge.autodesk.com/suppor...ns-module.html
Александр Ривилис вне форума  
 
Непрочитано 05.11.2014, 15:15
#15
Andrey_nadym


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


Ув. Александр Ривилис, может и не в тему, но в AutoCAD 2013 x64 данный макрос не реагирует на кнопку stop. Т.е. программа запускается и нумерует атрибуты блоков с заданными значениями, а остановить процесс нумерации не возможно - приходится принудительно завершать работу AutoCAD через диспетчер приложений.
Andrey_nadym вне форума  
 
Непрочитано 05.11.2014, 18:31
#16
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,405
Отправить сообщение для Александр Ривилис с помощью Skype™


Цитата:
Сообщение от Andrey_nadym Посмотреть сообщение
но в AutoCAD 2013 x64 данный макрос не реагирует на кнопку stop.
Это нормально. Если вспомнить, что во всех версиях x64 до 2014 использовался VBA 6.1, который был только 32-разрядный и соотвественно создавался специальный прокси-процесс для взаимодействия AutoCAD x64 и VBA x86, то так и должно быть. И думаю что это неисправимо.
Александр Ривилис вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Адаптация программы под AutoCad 2015

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
AutoCAD 2015 не видит видео карту. AlexeyDremov AutoCAD 59 13.02.2017 14:35
Экспорт в pdf-файл с искаженными цветами из AutoCAD 2015 Dr.. AutoCAD 8 10.09.2014 09:08
AutoCAD 2015 - что за линии между объектами? Const_s AutoCAD 5 04.09.2014 16:37
Почему большинство пользователей AutoCAD работают в устаревших версиях программы? ProPeller AutoCAD 126 08.07.2013 19:00