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

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

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

Ответ
Поиск в этой теме
Непрочитано 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
Как мне в этот набор добавить еще и "СпецСтрИзд"?
Просмотров: 6169
 
Непрочитано 13.01.2020, 16:33
#2
Boxa

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


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


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


"СпецСтр*" - и должно по идее все блоки нединамические с именами, начинающимися на СпецСтр, словить
Сергей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,787


Ну, я бы вообще переделал (не вижу большого смысла в таких наборах переменных):
Код:
[Выделить все]
 (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,787


Ну так заменить одну строку на несколько, делов-то:
Код:
[Выделить все]
 (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,787


Ей там неоткуда появляться. Переименуй в моем коде команду (ну, например, в 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
г. Норильск
Сообщений: 451


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


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


Лечение по фотографии...
Выложите (при наличии возможности) фрагмент файла со стабильно повторяющейся ошибкой, либо сами в отладчике пройдите, либо попробуйте на других машинах фирмы позапускать...
Сергей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,004


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

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


Сет, а кто тебе гарантирует, что порядок описания атрибутов именно такой, как ты предполагаешь?
__________________
Моя библиотека 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,004


Цитата:
Сообщение от Сет Посмотреть сообщение
Так порядок же определен самим блоком. Он заранее известен.
да, порядок следования вставок атрибутов должен совпадать с порядком следования определений атрибутов в определении блока. Но лучше "подстелить соломки" и еще имя тэга проверять, имхо - главное, чтобы атрибут вообще был)
Сергей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 вне форума  
Ответ
Вернуться   Форум 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