перестал работать VBA макрос

перестал работать VBA макрос · 11.01.2011, 15:29

Помогите чайнику.
В свое время получил VBA макрос для подсчета 3Dsolid в 2009 ACade,после установки 2011 версии Автокада и VBA enabler перестал работать макрос.Ругается,что не может найти библиотеку или проект.
подскажите,что сделать или может кто-нибудь изьявит желание переписать его на LISP(конечно мне бы хотелось остаться с VBA).
проблема в том,что познания ниже нулевого уровня и VBA и LISP
макрос вот такой

Олег (jr.) · 11.01.2011, 23:14

Примерно

Код:

[Выделить все]

(defun C:SolidCount (/ data box count height i leng lst  p1 p2 solid ss st tmp txt wid)
(vl-load-com)
  ;;Local defun
  (defun count_occurs (lst)
  (if (car lst)
    (cons (cons (car lst)
  (length (vl-remove-if-not
     (function (lambda (x)
          (eq x (car lst))))
     lst))
  )
   (count_occurs
     (vl-remove-if
       (function (lambda (x)
     (eq x (car lst))))
       lst)
     )
   )
    )
  )
  ;; main part
  (if 
   (setq ss (ssget  (list (cons 0 "3DSOLID"))))
   (progn
(setq i -1)
    
    (repeat (sslength ss)
    (setq solid (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
      (if (eq "Box"(vla-get-solidtype solid))
	(progn
	  (vla-getboundingbox solid 'p1 'p2)
	 (setq p1 (vlax-safearray->list p1)
	       p2 (vlax-safearray->list p2))
	  (setq wid (abs (apply '- (mapcar 'cadr (list p1 p2))))
		leng (abs (apply '- (mapcar 'car (list p1 p2))))
		height (abs (apply '- (mapcar 'caddr (list p1 p2)))))

(cond ((and (<= leng  wid)(<= leng height))
(if (<= leng height)

  (setq tmp (list leng wid height))

  (setq tmp (list leng height wid)))    
       )
	
     ((and (<=  wid leng)  (<= wid height))
(if (<= leng height)

  (setq tmp (list wid leng height))

  (setq tmp (list wid height leng)))
)

       (T
	(if ( <= leng wid)
	    (setq tmp (list height leng wid))
	    (setq tmp (list  height wid leng)))
	      
      )
    );_cond
	  
    (setq  data (cons tmp data))
    )
	)
      )
)
   )
  
  (setq count (count_occurs data)
	)
  (setq txt (chr 0))
  (foreach box count
    (setq st (strcat(rtos (caar box) 2 2) "x"
		    (rtos (cadar box) 2 2) "x"
		    (rtos (caddar box) 2 2) " - "
		    (itoa (cdr box)) "\\P")
	  )
    (setq txt (strcat txt st))   
    )
  
  (setq p1 (getpoint "\nТочка вставки мтекста: ")
	)
  (command "_mtext"  "_non" p1 "_W" (rtos(* (getvar "textsize") 20)2 0)  txt "")
;;;(print count);debug only
  (princ)
  )

(defun C:SCT(/ )  
(C:SolidCount)
  (princ)
  )
(prompt "\nВведите SCT для старта")
(prin1)

kvv0476 · 12.01.2011, 11:34

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

gomer · 12.01.2011, 21:43

удалено

Олег (jr.) · 12.01.2011, 21:58

Цитата:

Сообщение от kvv0476

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

Видимо где-то оставил лишние кавычки погоди малость проверю

dvim · 12.01.2011, 22:15

1 Вообще ваш макрос показывает только количество BOX (Те прямоугольников , а не всех солидов)

2 На 2010 автокаде идет без проблем. Имхо проблемы с 2011 связаны с неверно поставленным vbaEnabler, а не с кодом. Код прост.

3 Переписать его на Lisp тоже можно. В общем то переписанный Олег (jr.) лисп код работает, видимо уже исправлен

Олег (jr.) · 12.01.2011, 22:27

Заменил только вставку текста
Возможно какие-нибудь тонкости с чертежом
Приложи какой нибудь чертеж для теста (версии 2009 - не выше)

Код:

[Выделить все]

(defun C:SolidCount (/ data box count height i leng lst obj_text p1 p2 solid ss st tmp txt wid)
(vl-load-com)
  ;;Local defun
  (defun count_occurs (lst)
  (if (car lst)
    (cons (cons (car lst)
  (length (vl-remove-if-not
     (function (lambda (x)
          (eq x (car lst))))
     lst))
  )
   (count_occurs
     (vl-remove-if
       (function (lambda (x)
     (eq x (car lst))))
       lst)
     )
   )
    )
  )
  ;; main part
  
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
      )
  )
(if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
      )
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
  )


  (if 
   (setq ss (ssget  (list (cons 0 "3DSOLID"))))
   (progn
(setq i -1)
    
    (repeat (sslength ss)
    (setq solid (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
      (if (eq "Box"(vla-get-solidtype solid))
	(progn
	  (vla-getboundingbox solid 'p1 'p2)
	 (setq p1 (vlax-safearray->list p1)
	       p2 (vlax-safearray->list p2))
	  (setq wid (abs (apply '- (mapcar 'cadr (list p1 p2))))
		leng (abs (apply '- (mapcar 'car (list p1 p2))))
		height (abs (apply '- (mapcar 'caddr (list p1 p2)))))

(cond ((and (<= leng  wid)(<= leng height))
(if (<= leng height)

  (setq tmp (list leng wid height))

  (setq tmp (list leng height wid)))    
       )
	
     ((and (<=  wid leng)  (<= wid height))
(if (<= leng height)

  (setq tmp (list wid leng height))

  (setq tmp (list wid height leng)))
)

       (T
	(if ( <= leng wid)
	    (setq tmp (list height leng wid))
	    (setq tmp (list  height wid leng)))
	      
      )
    );_cond
	  
    (setq  data (cons tmp data))
    )
	)
      )
)
   )
  
  (setq count (count_occurs data)
	)
  (setq txt (chr 0))
  (foreach box count
    (setq st (strcat(rtos (caar box) 2 2) "x"
		    (rtos (cadar box) 2 2) "x"
		    (rtos (caddar box) 2 2) " - "
		    (itoa (cdr box)) "\\P")
	  )
    (setq txt (strcat txt st))   
    )
  
  (setq p1 (getpoint "\nТочка вставки мтекста: "))
  
  (setq obj_text (vlax-invoke acsp 'AddMText p1 0.0 txt))
;;;  (command "_mtext"  "_non" p1 "_W" (rtos(* (getvar "textsize") 20)2 0)  txt "")
;;;(print count);debug only
  (princ)
  )
(defun C:SCT(/ )  
(C:SolidCount)
  (princ)
  )
(prompt "\nВведите SCT для старта")
(prin1)

kvv0476 · 13.01.2011, 12:29

спасибо за ответ
запускается,даже нигде не ругается,но после выбора точки вставки ничего не происходит. Может,конечно,причина тривиальна,но в виду отсуттствия познаний в программировании сам не могу разобраться. Прилагаю простейшую модельку. Раньше на выходе после макроса был список 16х88х2500 - 25
6х1000х2500 - 10
примерно так он отрабатывал
Заранее извиняюсь,если уже достал,просто очень нужен для работы.
У меня стоит Винда 7 64-х битная,Автокады ставил все,какие только мог найти - результат нулевой,ни в одном не заработал макрос

AlexV · 13.01.2011, 13:09

Загружаем макрос из 1-го поста, alt + F11 -> редактор VBA, там в меню tools выбираем "References", в появившемся окне отключаем ссылки, отмеченные словом "MISSING", далее в списке находим и включаем библиотеку Autocad 2011 Type Librari. Макрос работает, "ящики" считает, сообщение показывает, MText создаеть..

kvv0476 · 13.01.2011, 13:34

AlexV, спасибо огромное. Вроде все работает. Даже не пришлось ничего отключать,сразу заработал. Ты - спаситель

Чего должен?

AlexV · 13.01.2011, 14:09

Цитата:

Сообщение от kvv0476

AlexV, спасибо огромное. Вроде все работает. Даже не пришлось ничего отключать,сразу заработал. Ты - спаситель

Чего должен?

Ну дык в том файле, что у меня выложен, я отключил/включил уже что надо. А чего должен? не знаю я, чего ты должен... ну, это.. "горячо любить свою Родину. Жить,учиться и бороться, как завещал великий Ленин".. И тогда тебя примут в пионеры!

Или "строго выполнять требования воинских уставов, приказы командиров и начальников..мужественно защищать свободу, независимость и конституционный строй России.." Тогда тебя возьмут в вооруженные силы.

kvv0476 · 13.01.2011, 14:29

Стар я уже и дл армии и для пионеров,а родине все отдал еще в молодости защищая спортивную ее честь

а реально этот список в excell импортировать?

Спасибо еще раз

AlexV · 13.01.2011, 14:31

Цитата:

Сообщение от kvv0476

Стар я уже и дл армии и для пионеров,а родине все отдал еще в молодости защищая спортивную ее честь

а реально этот список в excell импортировать?

Спасибо еще раз

реально..

kvv0476 · 13.01.2011, 14:43

я и не сомневался
но как это сделать,что бы работать с таблицей цифр?

Олег (jr.) · 13.01.2011, 15:05

Цитата:

Сообщение от kvv0476

спасибо за ответ
запускается,даже нигде не ругается,но после выбора точки вставки ничего не происходит. Может,конечно,причина тривиальна,но в виду отсуттствия познаний в программировании сам не могу разобраться. Прилагаю простейшую модельку. Раньше на выходе после макроса был список 16х88х2500 - 25
6х1000х2500 - 10
примерно так он отрабатывал
Заранее извиняюсь,если уже достал,просто очень нужен для работы.
У меня стоит Винда 7 64-х битная,Автокады ставил все,какие только мог найти - результат нулевой,ни в одном не заработал макрос

Распакуй архив и сохрани файл TextCommands.dll где тебе нужно.
В командной строке в Автокаде набери NETLOAD,
далее все подсказки в командной строке
(не гарантия что будет работать, проверить могу только на 2009-м 32b)
Добавил возможность сохранения данных в Эксель

AlexV · 13.01.2011, 16:08

Цитата:

Сообщение от kvv0476

я и не сомневался
но как это сделать,что бы работать с таблицей цифр?

на скорую руку:

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
"Расчет ведомости отправочного элемента. Макрос VBA Excel." Вопросы и ответы по програмке.	Brain Murder	Программирование	4	13.12.2010 18:42
проблема в АКАДе 2006 перестал работать набор lisp pltools	Nikolays	AutoCAD	4	30.10.2010 09:08
нарисовать полилинию и запустить макрос VBA	gizmo_zx	Программирование	8	24.12.2008 08:47
Как работать с объектами, созданными в ObjectARX через VBA	archee	Программирование	4	10.10.2008 14:33
Если VBA перестал работать	DaiverCAD	Программирование	3	07.02.2008 17:48