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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Новая задачка для ЛИСП умельцев

Новая задачка для ЛИСП умельцев

Закрытая тема
Поиск в этой теме
Непрочитано 06.08.2005, 19:23
Новая задачка для ЛИСП умельцев
Gostushev
 
проектирование КМ, КМД
 
Регистрация: 02.05.2005
Сообщений: 25

Коллеги!!!
Предлагаю немного разьмяться и соорудить небольшой ЛИСПик, способный облегчить жизнь инженеру. Требуется прога, способная проставлять значения из переменной "меаsurement"размера в "text override" этого же размера. Другими словами - есть прочерченная деталь в масштабе 1:1 с нанесенными на нее размерами, такая картинка никак не тянет на чертеж КМД, ее нужно немного поджать и растянуть местами, и как правило многие размеры забываешь "перебить" и они начинают "уменьшаться". Хотелось бы все выделить и дальше смело править чертеж, не боясь что где то на изделии появяться глупые размеры. Жду ваших предложений.
Просмотров: 33468
 
Непрочитано 26.04.2006, 12:32
#21
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от Krieger
<...>
1. После ввода команды - чтоб не выбирать ничего, а применить сразу ко всем размерам.
2. Если такая запись: "9x<>=6750" то выделять не надо.
Лови
Код:
[Выделить все]
;|=============================================================================
*    проверка размеров на правильность проставления. Вручную проставленные
* размеры меняют цвет на 1, вес линии на 2.11 мм. Переназначения текста не
* выполняется
=============================================================================|;
(defun c:kpblc-dimcheck	(/ *kpblc-activedoc* selset item temp_text)
  (vl-load-com)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (setq selset (ssget "_X" '((0 . "DIMENSION"))))
  (while (and selset
	      (> (sslength selset) 0)
	      (setq item (ssname selset 0))
	      (ssdel item selset)
	      ) ;_ end of and
    (setq item (vlax-ename->vla-object item))
    (if	(and (/= (vla-get-textoverride item) "")
	     (not (wcmatch (vla-get-textoverride item) "*<>*"))
	     ) ;_ end of and
      (progn
	(vla-put-color item 1)		; цвет - красный
	(vla-put-lineweight item 211)	; вес линии - 2.11
	(setq temp_text (vla-get-textoverride item))
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of while
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 12:36
#22
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от serg01
>>kpblc
вообще все размеры забиты вручную. Но если проскочит размер без override, желательно чтоб он подсветился и НЕ посчитался.
ЗЫ. Подсветка должна сработать не зависимо от размерного стиля (даже если в нем стоит другой цвет).
о как!
То бишь "подсветился" - это сменил цвет? Или выделение для него просто установить (как типа "выбран")? И опять же - textoverride может быть разным. Что делать, например, если вколочено "А вот здесь сердечник деревянный"? То есть не цифры? Или вбито "123,4565465,65"?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 12:47
#23
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


Цитата:
То бишь "подсветился" - это сменил цвет? Или выделение для него просто установить (как типа "выбран")? И опять же - textoverride может быть разным. Что делать, например, если вколочено "А вот здесь сердечник деревянный"? То есть не цифры? Или вбито "123,4565465,65"?
Да, подсветился значит сменить цвет. Если текст или числа не целые, то впринципе их можно упустить совсем и не обрабатывать вообще (просто нет таких). Но если не лень то на всякий случай можно и их цветом выделить.
serg01 вне форума  
 
Непрочитано 26.04.2006, 12:48
#24
forMA


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


для {Smirnoff}
---------------------
Отлично. Только хотел в свою очередь развести занудство по поводу допусков. Однако, все работает Хорошая работа!
forMA вне форума  
 
Непрочитано 26.04.2006, 13:01
#25
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от serg01
Да, подсветился значит сменить цвет. Если текст или числа не целые, то впринципе их можно упустить совсем и не обрабатывать вообще (просто нет таких). Но если не лень то на всякий случай можно и их цветом выделить.
Тогда попробуй:
Код:
[Выделить все]
;|=============================================================================
*    проверка размеров на правильность проставления. Вручную проставленные
* размеры меняют цвет на 1, вес линии на 2.11 мм. Переназначения текста не
* выполняется
=============================================================================|;
(defun c:kpblc-dimsumm (/ *kpblc-activedoc* selset item tmp_sum)

  (vl-load-com)
  (setq	*kpblc-activedoc*
	 (vla-get-activedocument (vlax-get-acad-object))
	tmp_sum	0.0
	) ;_ end of setq
  (vla-startundomark *kpblc-activedoc*)
  (setq selset (ssget "_X" '((0 . "DIMENSION"))))
  (while (and selset
	      (> (sslength selset) 0)
	      (setq item (ssname selset 0))
	      (ssdel item selset)
	      ) ;_ end of and
    (setq item (vlax-ename->vla-object item))
    (if	(and (/= (vla-get-textoverride item) "")
	     (not (wcmatch (vla-get-textoverride item) "*<>*"))
	     ) ;_ end of and
      (progn
	(setq tmp_sum
	       (+ tmp_sum
		  (cond
		    ((vl-string-search "=" (vla-get-textoverride item))
		     (atof
		       (vl-string-subst
			 "."
			 ","
			 (substr
			   (+ 2
			      (vl-string-search "=" (vla-get-textoverride item))
			      ) ;_ end of +
			   ) ;_ end of substr
			 ) ;_ end of vl-string-subst
		       ) ;_ end of atof
		     )
		    (t
		     (atof (vl-string-subst "." "," (vla-get-textoverride item)))
		     )
		    ) ;_ end of cond
		  ) ;_ end of +
	      ) ;_ end of setq
	) ;_ end of progn
      (progn
	(vla-put-color item 1)		; цвет - красный
	(vla-put-lineweight item 211)	; вес линии - 2.11
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of while
  (princ tmp_sum)
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun
Код на работоспособность не проверял, так что если не работает либо работает неправильно - скажи, буду дальше ковырять
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 13:21
#26
v_alex


 
Регистрация: 24.10.2005
Новокузнецк
Сообщений: 1,124
<phrase 1=


Цитата:
Сообщение от Asys
по делу ? :arrow: не фиг руками размеры вписывать !!!! Надо чертить ровно !!!!!!!!!
к сожалению невсегда возможно чертить ровно... это довольно частое явление в КМД, когда деталь рисуют по высоте в нормальном масштабе, а по длине нет... или вообще рисуют одну деталь, а к ней куча размеров...
v_alex вне форума  
 
Непрочитано 26.04.2006, 13:35
#27
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


у меня это одна из больных тем (после черчения в масштабах конечно)
asys вне форума  
 
Непрочитано 26.04.2006, 15:52
#28
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


>>kpblc
в целом код, работает, но:
1. он считает все размеры какие есть на чертеже;
2. если вбит размер с текстом он тоже считается;
3. нет возможности выбора считаемых размеров;
4. не отмечается ничего цветом и толщина не меняется;
5. и вначале я просил, чтоб посчитанная цифра вылевалась в новый размер, т.е. отметил несколько размеров, они посчитались, все что "не то" отметилось цветом (об этой
возможности мы говорили, можно ее не делать) и вылезло бы приглашение об указании 2-х точек нового размера.

В коде для Krieger меняется и цвет и толщина.

Заранее спасибо!
serg01 вне форума  
 
Непрочитано 26.04.2006, 16:17
#29
Кулик Алексей aka kpblc
Moderator

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


> serg01 : Давай тогда еще раз ТЗ с самого начала и для тупого. Я уже не могу сегодня нормальный код написать, это факт. Только если завтра.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 16:49
#30
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от serg01
>>kpblc
в целом код, работает, но:
1. он считает все размеры какие есть на чертеже;
2. если вбит размер с текстом он тоже считается;
3. нет возможности выбора считаемых размеров;
4. не отмечается ничего цветом и толщина не меняется;
5. и вначале я просил, чтоб посчитанная цифра вылевалась в новый размер, т.е. отметил несколько размеров, они посчитались, все что "не то" отметилось цветом (об этой
возможности мы говорили, можно ее не делать) и вылезло бы приглашение об указании 2-х точек нового размера.

В коде для Krieger меняется и цвет и толщина.

Заранее спасибо!
Может моя, когда-то, наспех собраная программа подойдет?
Код:
[Выделить все]
(defun d-orig ()
  (if (setq ss (ssget
		 "_X"
		 '((0 . "DIMENSION")
		   (1 . "~*<>*")
		  )
	       ) ;_  ssget
      ) ;_  setq
    (foreach x (vl-remove-if
		 (function listp)
		 (mapcar
		   (function cadr)
		   (ssnamex ss)
		 ) ;_  mapcar
	       ) ;_  vl-remove-if
      (setq en (entget x))
      (entmod
	(subst
	  (cons
	    1
	    (strcat (cdr (assoc 1 en))
		    "{\\C1; (Original: <>) }"
	    ) ;_  strcat
	  ) ;_  cons
	  (assoc 1 en)
	  en
	) ;_  subst
      ) ;_  entmod
      (entupd x)
    ) ;_  foreach
  ) ;_  if
) ;_  defun
Вроде и цвет меняется и старые обозначения сохраняются...
Делалось, чтоб тыкать носом
Елпанов Евгений вне форума  
 
Непрочитано 26.04.2006, 17:04
#31
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


>>kpblc
Хорошо. Давай заново.
Имеем размеры, которые проставлены вручную. Чтоб на калькуляторе всю цепочку не подсчитывать нужно выделить эти размеры, ввести команду и результатом должно явиться следующее:
1. Все то, что присутствует в поле text override в виде целых чисел (кроме текста, символов, текта+цифры, цифры не целые) посчиталось. Все, что кроме целых чисел должно выделиться красным цветом и в расчетах учавствовать не должно.
2. Следом после этого должно высвятиться приглашение на ввод 2-х точек начала и конца будующего линейного размера, а посчитанный результат должен будет записаться в поле text override этого размера.
Надеюсь теперь понятно объяснил.
serg01 вне форума  
 
Непрочитано 03.05.2006, 10:43
#32
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


так яро все начиналось...
serg01 вне форума  
 
Непрочитано 03.05.2006, 11:24
#33
Кулик Алексей aka kpblc
Moderator

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


Ну закрутился по работе, бывает, извини. Пробуй:
Код:
[Выделить все]
(defun c:dimcheck (/ adoc selset item sum ent_dim)
  (vl-load-com)
  (setq	adoc (vla-get-activedocument (vlax-get-acad-object))
	sum  0.
	) ;_ end of setq
  (vla-startundomark adoc)
  (if (not (setq selset (ssget "_I" '((0 . "DIMENSION")))))
    (setq selset (ssget '((0 . "DIMENSION"))))
    ) ;_ end of if
  (while (and selset
	      (> (sslength selset) 0)
	      ) ;_ end of and
    (setq item (ssname selset 0))
    (ssdel item selset)
    (setq item (vlax-ename->vla-object item))
    (if	(and (not (member (vla-get-textoverride item) '("" "<>")))
	     (not (vl-string-search
		    "."
		    (vl-string-subst "." "," (vla-get-textoverride item))
		    ) ;_ end of VL-STRING-SEARCH
		  ) ;_ end of not
	     (/= 0 (atoi (vla-get-textoverride item)))
	     ) ;_ end of and
      (setq sum (+ sum (atoi (vla-get-textoverride item))))
      (vla-put-color item 1)
      ) ;_ end of if
    ) ;_ end of while
  (if (vl-cmdf "_.dimlinear" pause pause pause)
    (progn
      (setq ent_dim (vlax-ename->vla-object (entlast)))
      (vla-put-textoverride ent_dim (rtos sum 2))
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 03.05.2006, 11:38
#34
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


Слушай, ну ты молодец просто! Теперь рутины поменьше! Спасибо!!!
serg01 вне форума  
 
Непрочитано 03.05.2006, 11:49
#35
Кулик Алексей aka kpblc
Moderator

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


Работает как надо?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 03.05.2006, 12:06
#36
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


ну почти как надо Считает все, что забито вручную, включая цифры с текстом. Если стоит цифра впереди текста, то он ее считает, если текст впереди цифры, то не считает. Ну и выделения цветом я понял, что тут нет.
Но этот вариант вполне устраивает!
serg01 вне форума  
 
Непрочитано 03.05.2006, 12:22
#37
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от serg01
ну почти как надо Считает все, что забито вручную, включая цифры с текстом. Если стоит цифра впереди текста, то он ее считает, если текст впереди цифры, то не считает. Ну и выделения цветом я понял, что тут нет.
Но этот вариант вполне устраивает!
Вот насчет цифр перед текстом - это да, тут я промахнулся. Не предусмотрел такого варианта. А цветом выделяло у меня. Можешь приложить вариант "чего есть и чего должно быть"? Именно dwg-файл (ессно, интересует только кусок с размерами)?
Вполне может оказаться, что у тебя в настройках размерного стиля стоит цвет не ByBlock, а ByLayer или какой-то предопределенный. Тогда работать, конечно, не будет.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 03.05.2006, 12:39
#38
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


Цвет стоит в стиле определенного цвета, это да. Удобно это. Поменял на byblock и естественно заработало. А нельзя сделать так, чтоб цвет менялся даже в случае установки его в размерном стиле жестко за определенным цветом ?

ЗЫ. лиспины, ранее проскакивавшие это делали, но функционал у них был не тот.
serg01 вне форума  
 
Непрочитано 03.05.2006, 13:02
#39
Кулик Алексей aka kpblc
Moderator

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


В общем несколько вариантов:
1. Меняет цвет внутри размеров на красный (установленный в переменной color)
Код:
[Выделить все]
(defun c:dimcheck (/ adoc selset item sum ent_dim color)
  (vl-load-com)
  (setq	adoc  (vla-get-activedocument (vlax-get-acad-object))
	sum   0.
	color 1
	      ;; Номер цвета для назначения
	) ;_ end of setq
  (vla-startundomark adoc)
  (if (not (setq selset (ssget "_I" '((0 . "DIMENSION")))))
    (setq selset (ssget '((0 . "DIMENSION"))))
    ) ;_ end of if
  (while (and selset
	      (> (sslength selset) 0)
	      ) ;_ end of and
    (setq item (ssname selset 0))
    (ssdel item selset)
    (setq item (vlax-ename->vla-object item))
    (if	(and (not (member (vla-get-textoverride item) '("" "<>")))
	     (not (vl-string-search
		    "."
		    (vl-string-subst "." "," (vla-get-textoverride item))
		    ) ;_ end of VL-STRING-SEARCH
		  ) ;_ end of not
	     (/= 0 (atoi (vla-get-textoverride item)))
	     (=	(strlen (itoa (atoi (vla-get-textoverride item))))
		(strlen (vla-get-textoverride item))
		) ;_ end of =
	     ) ;_ end of and
      (setq sum (+ sum (atoi (vla-get-textoverride item))))
      (foreach sub_item
	       '("color" "extensionlinecolor" "textcolor" "DimensionLineColor")
	(vlax-put-property item sub_item color)
	) ;_ end of foreach
      ) ;_ end of if
    ) ;_ end of while
  (if (vl-cmdf "_.dimlinear" pause pause pause)
    (progn
      (setq ent_dim (vlax-ename->vla-object (entlast)))
      (vla-put-textoverride ent_dim (rtos sum 2))
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
2. Все то же, но меняет цвет внутри размера на ByBlock, а сам размер -- на красный:
Код:
[Выделить все]
(defun c:dimcheck (/ adoc selset item sum ent_dim color)
  (vl-load-com)
  (setq	adoc  (vla-get-activedocument (vlax-get-acad-object))
	sum   0.
	color 1
	      ;; Номер цвета для назначения
	) ;_ end of setq
  (vla-startundomark adoc)
  (if (not (setq selset (ssget "_I" '((0 . "DIMENSION")))))
    (setq selset (ssget '((0 . "DIMENSION"))))
    ) ;_ end of if
  (while (and selset
	      (> (sslength selset) 0)
	      ) ;_ end of and
    (setq item (ssname selset 0))
    (ssdel item selset)
    (setq item (vlax-ename->vla-object item))
    (if	(and (not (member (vla-get-textoverride item) '("" "<>")))
	     (not (vl-string-search
		    "."
		    (vl-string-subst "." "," (vla-get-textoverride item))
		    ) ;_ end of VL-STRING-SEARCH
		  ) ;_ end of not
	     (/= 0 (atoi (vla-get-textoverride item)))
	     (=	(strlen (itoa (atoi (vla-get-textoverride item))))
		(strlen (vla-get-textoverride item))
		) ;_ end of =
	     ) ;_ end of and
      (setq sum (+ sum (atoi (vla-get-textoverride item))))
      (progn
	(foreach sub_item
		 '("extensionlinecolor" "textcolor" "DimensionLineColor")
	  (vlax-put-property item sub_item 0)
	  ) ;_ end of foreach
	(vla-put-color item color)
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of while
  (if (vl-cmdf "_.dimlinear" pause pause pause)
    (progn
      (setq ent_dim (vlax-ename->vla-object (entlast)))
      (vla-put-textoverride ent_dim (rtos sum 2))
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Если Евгений Елпанов подключится, получится в 2 раза короче и в 4 - быстрее
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 04.05.2006, 03:51
#40
serg01


 
Регистрация: 04.07.2005
Иркутск
Сообщений: 213


Работает и тот и другой! Спасибо!
serg01 вне форума  
Закрытая тема
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Новая задачка для ЛИСП умельцев

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Лисп для копирования данных нескольких мтекстов по принципу расположения. Red Nova LISP 14 18.06.2008 22:08