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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как создать набор из блоков двух типов? Помогите откорректировать программу.

Как создать набор из блоков двух типов? Помогите откорректировать программу.

Ответ
Страница 1 из 3 1 23 >
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 13.01.2020, 16:17 #1
Как создать набор из блоков двух типов? Помогите откорректировать программу.
Сет
 
Регистрация: 19.11.2014
Сообщений: 2,435
Пользуюсь не своей программой по подсчету массы элементов в спецификации. Каждая строка спецификации - это блок с атрибутами. Среди прочих атрибутов есть такие, где хранятся данные о "Количестве" и "Массе единицы". Программа формирует набор из блоков и проходит по каждому блоку, считывая "Количество" и "Массу единицы", перемножает их и суммирует.

Вот как выглядит полный текст программы:

Код:
[Выделить все] 
 (defun c:cs_calculate_weight (/ ss sorted ss_length i block attributes attribute sum_weight weight nof)  
(if (= (type (setq ss (vl-catch-all-apply (function (lambda () (ssget '((2 . "СпецСтр")))))))) 'pickset)
	(setq sorted (vl-sort (
		(lambda (/ tab item)
			(repeat
			        (setq tab  nil
				item (sslength ss)
				) ;_ end setq
				(setq tab (cons (ssname ss (setq item (1- item))) tab))
			) ;_ end repeat
		) ;_ end of LAMBDA
		)
		(function (lambda (a b) (> (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
	)) ;_ end of vl-sort
) ;_ end of if
(setq ss_length (sslength ss))
(setq sum_weight 0) 
(setq i 0)
(repeat ss_length
	(setq block (vlax-ename->vla-object (nth i sorted)))
	(setq attributes (vlax-variant-value (vla-GetAttributes block)))
	(setq nof (atof (vl-string-translate "," "." (vla-get-TextString (vlax-safearray-get-element attributes 3)))))
        (setq weight (atof (vl-string-translate "," "." (vla-get-TextString (vlax-safearray-get-element attributes 4)))))
	(setq sum_weight (+ sum_weight (* nof weight)))
	(setq i (1+ i))
) ; repeat
(princ (strcat "Общая масса: " (rtos sum_weight)))
(alert (strcat "Общая масса: " (rtos sum_weight)))
(princ)  
) ; defun
Имя блоков строк спецификации - "СпецСтр". Сейчас мне нужно в набор блоков включить еще один - "СпецСтрИзд". Он отличается от "СпецСтр" только взаимным расположением атрибутов. Как я понимаю набор из блоков формируется в этом фрагменте кода:

Код:
[Выделить все] 
 (if (= (type (setq ss (vl-catch-all-apply (function (lambda () (ssget '((2 . "СпецСтр")))))))) 'pickset)
	(setq sorted (vl-sort (
		(lambda (/ tab item)
			(repeat
			        (setq tab  nil
				item (sslength ss)
				) ;_ end setq
				(setq tab (cons (ssname ss (setq item (1- item))) tab))
			) ;_ end repeat
		) ;_ end of LAMBDA
		)
		(function (lambda (a b) (> (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
	)) ;_ end of vl-sort
) ;_ end of if
Как мне в этот набор добавить еще и "СпецСтрИзд"?
Просмотров: 6191
 
Непрочитано 13.01.2020, 16:33
#2
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,589

Вы бы файл чертежа выложили бы...
Boxa вне форума  
 
Непрочитано 13.01.2020, 16:48
1 | #3
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,052

"СпецСтр*" - и должно по идее все блоки нединамические с именами, начинающимися на СпецСтр, словить
Сергей812 вне форума  
 
Автор темы   Непрочитано 13.01.2020, 17:09
#4
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
"СпецСтр*" - и должно по идее все блоки нединамические с именами, начинающимися на СпецСтр, словить
Это сработало, спасибо
Сет вне форума  
 
Автор темы   Непрочитано 16.01.2020, 16:34
#5
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

И все же с этим лиспом есть какая-то проблема. Поначалу он вроде бы работает, но после нескольких использований начинает появляться такая ошибка:



Выяснить в какой момент появляется ошибка - пока не удалось. "PRODUCT" - это значение атрибута "Формат" у двух строк-блоков из сокращенной спецификации справа (см. тестовый файл). Атрибут чисто технический, нужен для организации работы с этими блоками. Иногда функция вычисления массы выдает ошибку "NORMAL" - это тоже атрибут "Формат", но для блоков в обычной спецификации слева.

Что не так с этим лиспом? Сам лисп в первом сообщении, я только заменил "СпецСтр" на "СпецСтр*". Тестовый файл во вложении.
Миниатюры
Нажмите на изображение для увеличения Название: Безымянный.png Просмотров: 238 Размер: 4.1 Кб ID: 222045  
Вложения
Тип файла: dwg
DWG 2013		 пример.dwg (110.5 Кб, 15 просмотров)
Сет вне форума  
 
Непрочитано 16.01.2020, 16:47
1 | #6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,848

Ну, я бы вообще переделал (не вижу большого смысла в таких наборах переменных):
Код:
[Выделить все] 
 (defun c:cs_calculate_weight (/ ss res)
  (if (= (type (setq ss (vl-catch-all-apply (function (lambda () (ssget '((2 . "спецстр*") (66 . 1))))))))
         'pickset
         ) ;_ end of =
    (progn (setq res (apply (function +)
                            (vl-remove nil
                                       (mapcar (function
                                                 (lambda (x)
                                                   (if (and (setq x (vlax-ename->vla-object x))
                                                            (setq x (vlax-safearray->list (vlax-variant-value (vla-getattributes x))))
                                                            (setq x (mapcar (function (lambda (a) (cons (vla-get-tagstring a) (vla-get-textstring a)))) x))
                                                            (setq x (cdr (assoc "МАССА" x)))
                                                            ) ;_ end of and
                                                     (atof (vl-string-translate "," "." x))
                                                     ) ;_ end of if
                                                   ) ;_ end of lambda
                                                 ) ;_ end of function
                                               ((lambda (/ tab item)
                                                  (repeat (setq tab  nil
                                                                item (sslength ss)
                                                                ) ;_ end setq
                                                    (setq tab (cons (ssname ss (setq item (1- item))) tab))
                                                    ) ;_ end of repeat
                                                  ) ;_ end of lambda
                                                )
                                               ) ;_ end of mapcar
                                       ) ;_ end of vl-remove
                            ) ;_ end of apply
                 ) ;_ end of setq
           (princ (strcat "Общая масса: " (rtos res 2)))
           (alert (strcat "Общая масса: " (rtos res 2)))
           (princ)
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
----- добавлено через 18 сек. -----
Чуть-чуть напутал со скобками и кодом. Выложил нормальный вариант.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Последний раз редактировалось Кулик Алексей aka kpblc, 16.01.2020 в 16:54.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 16.01.2020, 17:21
#7
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ну, я бы вообще переделал (не вижу большого смысла в таких наборах переменных)
Здесь что-то не то считается. По-моему не учитывается атрибут "КОЛ". Искомый результат - это сумма КОЛ*МАССА по всем блокам.
Сет вне форума  
 
Непрочитано 16.01.2020, 17:29
1 | #8
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,848

Ну так заменить одну строку на несколько, делов-то:
Код:
[Выделить все] 
 (defun c:cs_calculate_weight (/ ss res)
  (if (= (type (setq ss (vl-catch-all-apply (function (lambda () (ssget '((2 . "спецстр*") (66 . 1))))))))
         'pickset
         ) ;_ end of =
    (progn (setq
             res (apply (function +)
                        (vl-remove nil
                                   (mapcar (function
                                             (lambda (x)
                                               (if (and (setq x (vlax-ename->vla-object x))
                                                        (setq x (vlax-safearray->list (vlax-variant-value (vla-getattributes x))))
                                                        (setq x (mapcar (function (lambda (a) (cons (vla-get-tagstring a) (vla-get-textstring a)))) x))
                                                        (setq x (apply (function *)
                                                                       (mapcar (function (lambda (a)
                                                                                           (cond ((setq a (cdr (assoc a x))) (atof (vl-string-translate "," "." a)))
                                                                                                 (t 0)
                                                                                                 ) ;_ end of cond
                                                                                           ) ;_ end of lambda
                                                                                         ) ;_ end of function
                                                                               '("КОЛ" "МАССА")
                                                                               ) ;_ end of mapcar
                                                                       ) ;_ end of apply
                                                              ) ;_ end of setq
                                                        ) ;_ end of and
                                                 x
                                                 ) ;_ end of if
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                           ((lambda (/ tab item)
                                              (repeat (setq tab  nil
                                                            item (sslength ss)
                                                            ) ;_ end setq
                                                (setq tab (cons (ssname ss (setq item (1- item))) tab))
                                                ) ;_ end of repeat
                                              ) ;_ end of lambda
                                            )
                                           ) ;_ end of mapcar
                                   ) ;_ end of vl-remove
                        ) ;_ end of apply
             ) ;_ end of setq
           (princ (strcat "Общая масса: " (rtos res 2)))
           (alert (strcat "Общая масса: " (rtos res 2)))
           (princ)
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 16.01.2020, 17:44
#9
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ну так заменить одну строку на несколько, делов-то:
Я в этом лиспе плохо соображаю, поэтому для меня это сложно. Спасибо

----- добавлено через ~20 мин. -----
Ну вот, поиспользовал немного этот код, но снова появляется ошибка из поста 5. По-моему она начинает проявляться после того, как я добавляю в чертеж еще один экземпляр блока СпецСтр или СпецСтрИзд, но не уверен.
Сет вне форума  
 
Непрочитано 16.01.2020, 18:39
#10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,848

Ей там неоткуда появляться. Переименуй в моем коде команду (ну, например, в calc1) и вызывай по новому названию.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 20.01.2020, 15:08
#11
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ей там неоткуда появляться. Переименуй в моем коде команду (ну, например, в calc1) и вызывай по новому названию.
А какая разница какое название команды? Вроде бы оно не должно влиять.

Сообщение при ошибке - неверная функция: "PRODUCT". Такое сообщение появляется, если последним в чертеж был добавлен блок СпецСтрИзд. У него в атрибут Формат я помещаю текст PRODUCT. Если же последним в чертеж добавлен блок СпецСтр, то при попытке подсчета суммарного веса выдается сообщение неверная функция: "NORMAL". Я программно в атрибут Формат блока СпецСтр помещаю текст NORMAL. Почему-то команда подсчета общего веса cs_calculate_weight считает текст в атрибуте Формат блоков СпецСтр и СпецСтрИзд именем функции и пытается эту функцию запустить. Не понимаю как это происходит.

----- добавлено через ~5 мин. -----
И, кстати, я пользуюсь еще лиспом, который нумерует строки спецификации, состоящие из блоков СпецСтр.

Код:
[Выделить все] 
 (defun c:cs_numeration (/ ss sorted ss_length i pos block attributes attribute)  
(if (= (type (setq ss (vl-catch-all-apply (function (lambda () (ssget '((2 . "СпецСтр")))))))) 'pickset)
	(setq sorted (vl-sort (
		(lambda (/ tab item)
			(repeat
			        (setq tab  nil
				item (sslength ss)
				) ;_ end setq
				(setq tab (cons (ssname ss (setq item (1- item))) tab))
			) ;_ end repeat
		) ;_ end of LAMBDA
		)
		(function (lambda (a b) (> (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
	)) ;_ end of vl-sort
) ;_ end of if
(setq ss_length (sslength ss))
(setq pos (atoi (getstring T "Введите стартовый номер:")))
(setq i 0)
(repeat ss_length
	(setq block (vlax-ename->vla-object (nth i sorted)))
	(setq attributes (vlax-variant-value (vla-GetAttributes block)))
	(setq attribute (vlax-safearray-get-element attributes 0))
	(vla-put-TextString attribute (itoa pos))
	(setq pos (1+ pos))
	(setq i (1+ i))
) ; repeat
) ; defun
Этот лисп тоже перестает работать с той же ошибкой, что и cs_calculate_weight.
Сет вне форума  
 
Непрочитано 20.01.2020, 16:30
#12
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 470

"Меня терзают смутные сомнения..."
Сразу после ssget "икс" точно не пропущен?
__________________
Счастливо, Алексей!
===AAA=== вне форума  
 
Непрочитано 20.01.2020, 16:34
#13
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,052

Лечение по фотографии...
Выложите (при наличии возможности) фрагмент файла со стабильно повторяющейся ошибкой, либо сами в отладчике пройдите, либо попробуйте на других машинах фирмы позапускать...
Сергей812 вне форума  
 
Автор темы   Непрочитано 20.01.2020, 16:42
#14
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Цитата:
Сообщение от ===AAA=== Посмотреть сообщение
Сразу после ssget "икс" точно не пропущен?
Это не мой код, я не понимаю как он работает.

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Выложите (при наличии возможности) фрагмент файла со стабильно повторяющейся ошибкой
В сообщении номер 5 я выкладывал файл. Но я не смог точно выяснить при каких условиях появляется ошибка. Некоторое время все работает, но вскоре перестает. Перезагрузка файла решает проблему.
Сет вне форума  
 
Непрочитано 20.01.2020, 17:20
#15
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,052

Цитата:
Сообщение от Сет Посмотреть сообщение
В сообщении номер 5 я выкладывал файл.
вас нормоконтроль требует таблицу? - а то логичнее было бы доделать блок с имитацией границ и просто из них собирать спецификацию. Ну и блок шапки сверху.
Сергей812 вне форума  
 
Непрочитано 20.01.2020, 17:31
#16
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,848

Сет, а кто тебе гарантирует, что порядок описания атрибутов именно такой, как ты предполагаешь?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 21.01.2020, 10:29
#17
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
вас нормоконтроль требует таблицу? - а то логичнее было бы доделать блок с имитацией границ и просто из них собирать спецификацию. Ну и блок шапки сверху.
Нет, ничего не требуют. Просто мне так удобнее.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Сет, а кто тебе гарантирует, что порядок описания атрибутов именно такой, как ты предполагаешь?
Так порядок же определен самим блоком. Он заранее известен.
Сет вне форума  
 
Непрочитано 21.01.2020, 14:48
#18
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,052

Цитата:
Сообщение от Сет Посмотреть сообщение
Так порядок же определен самим блоком. Он заранее известен.
да, порядок следования вставок атрибутов должен совпадать с порядком следования определений атрибутов в определении блока. Но лучше "подстелить соломки" и еще имя тэга проверять, имхо - главное, чтобы атрибут вообще был)
Сергей812 вне форума  
 
Автор темы   Непрочитано 22.01.2020, 13:15
#19
Сет


 
Регистрация: 19.11.2014
Сообщений: 2,435

Похоже ошибка начинает появляться сразу после того, как я добавляю в чертеж экземпляр блока "СпецСтр" или "СпецСтрИзд". Причем когда это делаю с помощью специального лиспа. Если просто добавить этот блок в чертеж прямо с палитры блоков - ошибка не возникает. А я добавляю с помощью вот такого набора команд.

Код:
[Выделить все] 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Добавление строки спецификации ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cs_add_specification (/ point file mode block)
(startapp "c:\\Работа\\Программирование\\Спецификации\\Win32\\Debug\\Specification.exe")
(setq point (getpoint "\nУкажите точку вставки:"))
(setq file (open "D:\\MyAutoCAD\\spec.txt" "r"))
(setq mode (read-line file))
(setq type (read-line file))
(cond	
	((= mode "ADD")
		(cond
			((= type "NORMAL")
			(setq block (vla-InsertBlock model_space (vlax-3D-point point) "СпецСтр" 1 1 1 0))
			(vla-put-Layer block "000-Белый") 
			(cs_make_specification_string block))
			((= type "PRODUCT")
			(setq block (vla-InsertBlock model_space (vlax-3D-point point) "СпецСтрИзд" 1 1 1 0))
			(vla-put-Layer block "000-Белый") 
			(cs_make_specification_string block))
		) ; cond
	) ; ADD
) ; cond
(close file)
) ; defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Настройка атрибутов блока ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cs_make_specification_string (block /				     
file				     
strings
string
attributes
attribute				     
mode
string_type
element_type
name
name1
name2
name3				     
name4				     
len				     
offset
)
(setq strings (list))
(setq file (open "D:\\MyAutoCAD\\spec.txt" "r"))
(setq string (list (read-line file)))
(while (/= (car string) nil)
	(setq strings (append strings string))
	(setq string (list (read-line file)))
) ; while
(close file)
(setq attributes (vlax-variant-value (vla-GetAttributes block)))
(setq mode (nth 0 strings)) 
(setq string_type (nth 1 strings))
(setq element_type (nth 2 strings))
(cond
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Прокат ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Прокат")
	(setq len    (nth 15 strings))  
	(setq offset (nth 16 strings))
	(setq name1  (nth 10  strings)) 
	(setq name2  (nth 5  strings))  
	(setq name3  (nth 9  strings))
	(if (/= len "")
	        (setq name4 (strcat "L=" len))
	        (setq name4 "")
	) ; if
	(setq name (strcat "\\A1;" name1 " {\\H0.88x;\\S" name2 "/" name3 ";} " name4)) 
	(setq attribute (vlax-safearray-get-element attributes 2)) 
	(if (= mode "ADD") (vla-Move attribute (vlax-3D-point '(0 0 0)) (vlax-3D-point (list 0 (atoi offset) 0))))
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond
	(vla-put-TextString (vlax-safearray-get-element attributes 8)  name1)              ; наименование 1
	(vla-put-TextString (vlax-safearray-get-element attributes 9)  name2)              ; наименование 2 (верх дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 10) name3)              ; наименование 3 (низ дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 11) name4)              ; наименование 4
	(vla-put-TextString (vlax-safearray-get-element attributes 17) len)                ; длина
	(vla-put-TextString (vlax-safearray-get-element attributes 18) offset)             ; смещение
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))   ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))   ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))   ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))   ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))   ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))   ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 7)  (nth 11 strings))   ; тип проката
	(vla-put-TextString (vlax-safearray-get-element attributes 12) (nth 12 strings))   ; марка
	(vla-put-TextString (vlax-safearray-get-element attributes 13) (nth 13 strings))   ; сталь
	(vla-put-TextString (vlax-safearray-get-element attributes 14) (nth 14 strings))   ; марка стали
	(vla-put-TextString (vlax-safearray-get-element attributes 19) (nth 1  strings))   ; формат	
	) ; прокат
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Лист ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Лист")
	(setq offset (nth 15 strings))
	(setq name1  (nth 10 strings)) 
	(setq name2  (nth 5  strings))  
	(setq name3  (nth 9  strings))  
	(setq name4  "")
	(setq name (strcat "\\A1;" name1 " {\\H0.88x;\\S" name2 "/" name3 ";} ")) 
	(setq attribute (vlax-safearray-get-element attributes 2)) 
	(if (= mode "ADD") (vla-Move attribute (vlax-3D-point '(0 0 0)) (vlax-3D-point (list 0 (atoi offset) 0))))
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond
	(vla-put-TextString (vlax-safearray-get-element attributes 8)  name1)              ; наименование 1
	(vla-put-TextString (vlax-safearray-get-element attributes 9)  name2)              ; наименование 2 (верх дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 10) name3)              ; наименование 3 (низ дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 18) offset)             ; смещение
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))   ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))   ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))   ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))   ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))   ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))   ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 13) (nth 4  strings))   ; сталь
	(vla-put-TextString (vlax-safearray-get-element attributes 14) (nth 11 strings))   ; марка стали
        (vla-put-TextString (vlax-safearray-get-element attributes 15) (nth 12 strings))   ; толщина
	(vla-put-TextString (vlax-safearray-get-element attributes 16) (nth 13 strings))   ; ширина
	(vla-put-TextString (vlax-safearray-get-element attributes 17) (nth 14 strings))   ; длина
	(vla-put-TextString (vlax-safearray-get-element attributes 19) (nth 1  strings))   ; формат	
	) ; лист
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Полоса ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Полоса")
        (setq len    (nth 14 strings))  
	(setq offset (nth 15 strings))
	(setq name1  (nth 10 strings)) 
	(setq name2  (nth 5  strings))  
	(setq name3  (nth 9  strings))
	(if (/= len "")
	        (setq name4 (strcat "L=" len))
	        (setq name4 "")
	) ; if
	(setq name (strcat "\\A1;" name1 " {\\H0.88x;\\S" name2 "/" name3 ";} " name4)) 
	(setq attribute (vlax-safearray-get-element attributes 2)) 
	(if (= mode "ADD") (vla-Move attribute (vlax-3D-point '(0 0 0)) (vlax-3D-point (list 0 (atoi offset) 0))))
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond
	(vla-put-TextString (vlax-safearray-get-element attributes 8)  name1)              ; наименование 1
	(vla-put-TextString (vlax-safearray-get-element attributes 9)  name2)              ; наименование 2 (верх дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 10) name3)              ; наименование 3 (низ дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 11) name4)              ; наименование 4
	(vla-put-TextString (vlax-safearray-get-element attributes 17) len)                ; длина
	(vla-put-TextString (vlax-safearray-get-element attributes 18) offset)             ; смещение
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))   ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))   ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))   ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))   ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))   ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))   ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 13) (nth 4  strings))   ; сталь
	(vla-put-TextString (vlax-safearray-get-element attributes 14) (nth 11 strings))   ; марка стали
        (vla-put-TextString (vlax-safearray-get-element attributes 15) (nth 12 strings))   ; толщина
	(vla-put-TextString (vlax-safearray-get-element attributes 16) (nth 13 strings))   ; ширина
	(vla-put-TextString (vlax-safearray-get-element attributes 19) (nth 1  strings))   ; формат	
	) ; полоса
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Круг ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Круг")
        (setq len    (nth 13 strings))  
	(setq offset (nth 14 strings))
	(setq name1  (nth 10 strings)) 
	(setq name2  (nth 5  strings))  
	(setq name3  (nth 9  strings))
	(if (/= len "")
	        (setq name4 (strcat "L=" len))
	        (setq name4 "")
	) ; if
	(setq name (strcat "\\A1;" name1 " {\\H0.88x;\\S" name2 "/" name3 ";} " name4)) 
	(setq attribute (vlax-safearray-get-element attributes 2)) 
	(if (= mode "ADD") (vla-Move attribute (vlax-3D-point '(0 0 0)) (vlax-3D-point (list 0 (atoi offset) 0))))
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond
	(vla-put-TextString (vlax-safearray-get-element attributes 8)  name1)              ; наименование 1
	(vla-put-TextString (vlax-safearray-get-element attributes 9)  name2)              ; наименование 2 (верх дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 10) name3)              ; наименование 3 (низ дроби)
	(vla-put-TextString (vlax-safearray-get-element attributes 11) name4)              ; наименование 4
	(vla-put-TextString (vlax-safearray-get-element attributes 17) len)                ; длина
	(vla-put-TextString (vlax-safearray-get-element attributes 18) offset)             ; смещение
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))   ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))   ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))   ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))   ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))   ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))   ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 12) (nth 11 strings))   ; марка (диаметр)
	(vla-put-TextString (vlax-safearray-get-element attributes 13) (nth 4  strings))   ; сталь
	(vla-put-TextString (vlax-safearray-get-element attributes 14) (nth 12 strings))   ; марка стали
	(vla-put-TextString (vlax-safearray-get-element attributes 19) (nth 1  strings))   ; формат	
	) ; круг
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Дерево ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Дерево")
	(setq name (nth 5 strings)) 
	(setq attribute (vlax-safearray-get-element attributes 2)) 
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond    
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))                 ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))                 ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))                 ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))                 ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))                 ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))                 ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 15) (nth 9  strings))                 ; толщина
	(vla-put-TextString (vlax-safearray-get-element attributes 16) (nth 10 strings))                 ; ширина
	(vla-put-TextString (vlax-safearray-get-element attributes 17) (nth 11 strings))                 ; длина
	(vla-put-TextString (vlax-safearray-get-element attributes 18) (nth 12 strings))                 ; смещение
	) ; дерево
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Арматура ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Арматура")
	(setq name (strcat "%%c" (nth 5 strings))) 
	(setq attribute (vlax-safearray-get-element attributes 2)) 		 
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))                 ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))                 ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))                 ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))                 ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))                 ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))                 ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 9)  (nth 5  strings))                 ; наименование без значка диаметра
	(vla-put-TextString (vlax-safearray-get-element attributes 12) (nth 10 strings))                ; марка (диаметр)
	(vla-put-TextString (vlax-safearray-get-element attributes 13) (nth 4  strings))                 ; сталь
	(vla-put-TextString (vlax-safearray-get-element attributes 14) (nth 11 strings))                 ; марка стали
	(vla-put-TextString (vlax-safearray-get-element attributes 17) (nth 12 strings))                 ; длина
	(vla-put-TextString (vlax-safearray-get-element attributes 18) (nth 13 strings))                 ; смещение
	(vla-put-TextString (vlax-safearray-get-element attributes 19) (nth 1  strings))	         ; формат	
	) ; арматура
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Текст ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Текст")
	(setq name (nth 5 strings)) 
	(setq attribute (vlax-safearray-get-element attributes 2))
	(cond 
		((= string_type "NORMAL")
		(cs_compress_text name attribute 6250)		
		) ; NORMAL 
		((= string_type "PRODUCT")
		(cs_compress_text name attribute 5750)
		) ; PRODUCT
	) ; cond 
	(vla-put-TextString (vlax-safearray-get-element attributes 0)  (nth 3  strings))                 ; позиция
	(vla-put-TextString (vlax-safearray-get-element attributes 1)  (nth 4  strings))                 ; обозначение
	(vla-put-TextString (vlax-safearray-get-element attributes 3)  (nth 6  strings))                 ; количество
	(vla-put-TextString (vlax-safearray-get-element attributes 4)  (nth 7  strings))                 ; масса
	(vla-put-TextString (vlax-safearray-get-element attributes 5)  (nth 8  strings))                 ; примечание
	(vla-put-TextString (vlax-safearray-get-element attributes 6)  (nth 2  strings))                 ; тип
	(vla-put-TextString (vlax-safearray-get-element attributes 19) (nth 1  strings))	         ; формат	
	) ; текст
) ; cond
) ; defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Сжатие текста ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cs_compress_text (str attribute length / mtext p1 p2 height compression str_new)
	(setq mtext (vla-AddMText model_space (vlax-3D-point '(0 0 0)) length str))
	(vla-GetBoundingBox mtext 'p1 'p2)
	(setq height (- (vlax-safearray-get-element p2 1) (vlax-safearray-get-element p1 1)))
	(if (> height 600)
		(progn		    
			(setq compression 1.00)
			(while (> height 600)
				(setq compression (- compression 0.02))
				(setq str_new (strcat "{\\T" (rtos compression 2 2) ";" str "}"))
				(vla-put-TextString mtext str_new)
				(vla-GetBoundingBox mtext 'p1 'p2)
				(setq height (- (vlax-safearray-get-element p2 1) (vlax-safearray-get-element p1 1)))
			) ; while
			(vla-put-TextString attribute str_new)
		) ; progn
	        (vla-put-TextString attribute str)
	) ; if
	(vla-Delete mtext)
) ; defun
Тут наверное много кода и разобраться сложно, но суть сводится к следующему. Я сделал на панели инструментов отдельную кнопку, по нажатию на которую запускается лисп cs_add_specification. Эта функция вызывает внешнее приложение Specification.exe. В нем я задаю параметры позиции, которую хочу добавить в спецификацию. По завершении я закрываю это приложение и формируется текстовый файл spec.txt, в котором описана специальным образом добавляемая позиция и в чертеж добавляется экземпляр блока "СпецСтр" или "СпецСтрИзд". Функция cs_make_specification_string считывает файл spec.txt и заполняет атрибуты добавленного блока "СпецСтр" или "СпецСтрИзд".

Вот при использовании всего этого механизма и последующей попытке подсчитать сумму позиций по спецификации функцией cs_calculate_weight начинает появляться ошибка из поста 5.
Сет вне форума  
 
Непрочитано 22.01.2020, 13:34
#20
ciril

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 283

Цитата:
Сообщение от Сет Посмотреть сообщение
Сообщение при ошибке - неверная функция: "PRODUCT". Такое сообщение появляется, если последним в чертеж был добавлен блок СпецСтрИзд. У него в атрибут Формат я помещаю текст PRODUCT. Если же последним в чертеж добавлен блок СпецСтр, то при попытке подсчета суммарного веса выдается сообщение неверная функция: "NORMAL". Я программно в атрибут Формат блока СпецСтр помещаю текст NORMAL
Цитата:
Сообщение от Сергей812 Посмотреть сообщение
либо сами в отладчике пройдите
Повторю хороший совет, пройдите сами в отладчике, видно будет, когда функция пытается выполнить значение атрибута. Иначе даже не по фотографии лечение, а по рассказам о фотографии.
__________________
На работе было скучно:shout:
ciril вне форума  
Ответ
Страница 1 из 3 1 23 >
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как создать набор из блоков двух типов? Помогите откорректировать программу.

Размещение рекламы

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Требуется написать программу для автоматической расстановки блоков по полилинии. Mozgolom Поиск исполнителей 0 30.12.2019 15:50
Как создать одно 3д тело из двух цветов (или материалов)? Loksana AutoCAD 5 26.01.2018 14:30
народ помогите создать линию проектируемой телефонной канализации ОлегD AutoCAD 13 23.08.2011 19:30
Подсчет и сортировка блоков на текущем слое. Помогите отредактировать. Kortes Программирование 17 26.03.2010 18:46
Как создать сопряжение двух швеллеров по косому срезу BM60 AutoCAD 3 24.04.2009 14:56

Обратная связь - Вверх