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

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

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

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

Коллеги!!!
Предлагаю немного разьмяться и соорудить небольшой ЛИСПик, способный облегчить жизнь инженеру. Требуется прога, способная проставлять значения из переменной "меаsurement"размера в "text override" этого же размера. Другими словами - есть прочерченная деталь в масштабе 1:1 с нанесенными на нее размерами, такая картинка никак не тянет на чертеж КМД, ее нужно немного поджать и растянуть местами, и как правило многие размеры забываешь "перебить" и они начинают "уменьшаться". Хотелось бы все выделить и дальше смело править чертеж, не боясь что где то на изделии появяться глупые размеры. Жду ваших предложений.
Просмотров: 23630
 
Непрочитано 07.08.2005, 01:36
#2
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,148


Г-н Gostushev,
Сегодня я не ленив. но добр. А посему - ловите лсипу, пользуйтесе на здровье и сугубо и трегубо благодарите меня за то. что я есть.
Код:
[Выделить все]
(defun C:mes2txt ( / ass flag)
  (prompt "\nВыберите размеры для перезаписи")
  (ssget)
  (setq ass (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vlax-for dmob ass
    (if (wcmatch (vla-get-ObjectName dmob) "*Dimension")
      (progn (vla-put-TextOverride dmob (rtos (vla-get-measurement dmob)))
	(setq flag 1))));vlax-for
  (if (null flag) (alert "Не то выбралб дубина! Будь внимательнее!"))
);end
Лентяй вне форума  
 
Непрочитано 07.08.2005, 02:37
#3
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


>Лентяй

1. А как же значки радиусов и диаметров?
2. А как же количество десятичных знаков которое для размеров устанавливается отдельно?
3. А если слой случайно заблокирован, то выскочит непонятная для пользователя ошибка и что уже "надписано" а что нет совершенно непонятно.

>Gostushev
Должен переписывать размеры "как есть". Я подумал что нелишне такие размеры временно метить и они красятся в цвет №22 (если конечно в определении стиля цвета ByBlock). Чтобы убрать покраску, сотрите строчку (vla-put-Color dim 22).
Код:
[Выделить все]
(defun c:dimr(/ COPYDIM CURLAY DELSET DIMLST
	      DIMSET ERRCOUNT LAYCOL LENT
	      NEXTENT OVTEXT *ERROR* ACTDOC
	      OLDECHO)

  (defun *ERROR* (msg)
    (setvar "CMDECHO" oldEcho)
    ); end of error

  (vl-load-com)
  (setq oldEcho(getvar "CMDECHO")
	actDoc(vla-get-ActiveDocument
		      (vlax-get-acad-object))
	layCol(vla-get-Layers actDoc)
	); end setq
  (setvar "CMDECHO" 0)
  (if
    (setq dimSet
	   (ssget '((0 . "DIMENSION"))))
    (progn
      (setq dimLst
	     (mapcar 'vlax-ename->vla-object 
                    (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex dimSet))))
	    errCount 0
	    ); end setq
      (vla-StartUndoMark actDoc)
      (foreach dim dimLst
	(setq curLay(vla-get-Layer dim))
	(if
	  (/= :vlax-true
	      (vla-get-Lock(Col_Item_Find layCol curLay)))
	  (progn
	(setq lEnt(entlast)
	      delSet(ssadd)
	      copyDim(vla-Copy dim)
	      ); end setq
	(command "_.Explode"(entlast))
	 (setq nextEnt(entnext lEnt))
	(while nextEnt
	  (ssadd nextEnt delSet)
	  (if
	    (member
	      (cdr(assoc 0(entget nextEnt)))
	      '("TEXT" "MTEXT")); end member
	    (setq ovText
		   (cdr(assoc 1(entget nextEnt))))
	    ); end if
	  (command "_.erase" nextEnt "")
	  (setq nextEnt(entnext nextEnt))
	    ); end whlie
	(vla-put-TextOverride dim ovText)
	(vla-put-Color dim 22)
	); end progn
	  (setq errCount(1+ errCount))
	  ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ
	  (strcat "\n"
		  (itoa errCount)" were on locked layer!"))
	); end if
      (vla-EndUndoMark actDoc)
      ); end progn
    ); end if
  (setvar "CMDECHO" oldEcho)
  (princ)
  ); end of c:dimr

(defun Col_Item_Find (Collection Item / result)
  (if
    (not
      (vl-catch-all-error-p  
	(setq result
	       (vl-catch-all-apply 'vla-item
		 (list Collection Item))))) 
    result
    ); end if
  ); end of Col_Item_Find
{Smirnoff} вне форума  
 
Непрочитано 07.08.2005, 11:17
#4
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,148


Цитата:
Лентяй
1. А как же значки радиусов и диаметров?
2. А как же количество десятичных знаков которое для размеров устанавливается отдельно?
3. А если слой случайно заблокирован, то выскочит непонятная для пользователя ошибка и что уже "надписано" а что нет совершенно непонятно.
Послушайте, Фантомас, вам кто-нибудь говорил, что вы - зануда? :shock: Ладно, так и быть - вот вам апдэйтнутая лиспа, ибо добр аз есмь днесь.
Код:
[Выделить все]
(defun C:mes2txt ( / ass flag pfx) 
  (prompt "\nВыберите размеры для перезаписи") 
  (ssget) 
  (setq ass (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vlax-for dmob ass 
    (if (wcmatch (vla-get-ObjectName dmob) "*Dimension")
      (progn
	(if (= (vla-get-ObjectName dmob) "AcDb2LineAngularDimension")
	  (vla-put-TextOverride dmob (strcat (rtos (/ (* (vla-get-measurement dmob) 180) pi)
		2 (vla-get-TextPrecision dmob)) "%%D"))
	  (progn (cond ((= (vla-get-ObjectName dmob) "AcDbRadialDimension") (setq pfx "R"))
	      ((= (vla-get-ObjectName dmob) "AcDbRotatedDimension") (setq pfx ""))
	      ((= (vla-get-ObjectName dmob) "AcDbDiametricDimension") (setq pfx "%%C")))
	    (vla-put-TextOverride dmob (strcat pfx (rtos (vla-get-measurement dmob)
		(vla-get-UnitsFormat dmob) (vla-get-PrimaryUnitsPrecision dmob)))));progn
	);if
	(setq flag 1))));vlax-for
  (if (null flag) (alert "Не то выбрал, дубина! Будь внимательнее!")) 
);end
Все равно короче. чем у вас.
Да, а заморозками-отморозками - вожжайтесь сами, ибо мне - ЛЕНИВО!
Лентяй вне форума  
 
Непрочитано 07.08.2005, 12:16
#5
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


>Лентяй
Цитата:
Послушайте, Фантомас, вам кто-нибудь говорил, что вы - зануда?
Говорили и не раз. Но у всех свои недостатки. Вы как ни кто меня поймете
Цитата:
Все равно короче. чем у вас. Laughing
Да, а заморозками-отморозками - вожжайтесь сами, ибо мне - ЛЕНИВО! Very Happy
Вот это лучше. Однако тоже неучитывает многих вещей. Например наличие префиксов и суффиксов, альтернативных единий и т. д. и т. п. И если всё это добавить, а также проверочки то код ваш отнюдь не будет короче. В прочем наш "заказчик" в своём случае скорее всего незаметит раницы.

Я просто избрал другой "железобетонный", хотя и не элегантный способ забирания текста "как есть" из взорванной копии размера.

Да я зануда, однако считаю что если человек просит програмку то невполне вежливо давать ему полуфабрикат, а хотя бы что то приближенное к тому как оно должно быть или хотя бы предупреждать где могут возникнуть проблемы.

Кстати, уже совсем будучи занудой. После повторного использования програмка выдаёт ошибку:
Код:
[Выделить все]
; error: Automation Error. Calling method Clear of interface IAcadSelectionSet
{Smirnoff} вне форума  
 
Непрочитано 07.08.2005, 23:33
#6
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,148


Цитата:
Говорили и не раз. Но у всех свои недостатки. Вы как ни кто меня поймете
Wanna hug?
Цитата:
Однако тоже неучитывает многих вещей. Например наличие префиксов и суффиксов, альтернативных единий и т. д. и т. п.
Альтернативные единицы в расейском КМД? Пардоньте-с, но это уже не занудство, но просто - извращение. Такова же извратна есть и проверка на кол-во дечятичных знаков, ибо все размеры - сугубо в мм, что есть целочисленны.
Цитата:
Кстати, уже совсем будучи занудой. После повторного использования програмка выдаёт ошибку:
А это уже у вас компьютер - занудный :shock: Под стать хозяину, наверное А ежели серьезно, то я полагал, что внесение ass в список параметров автоматически очищает соответствующую запись при завершении прогораммы. Видимо, надежнее добавить строку
Код:
[Выделить все]
(vla-release ass)
С занудским приветом!
Лентяй вне форума  
 
Автор темы   Непрочитано 07.08.2005, 23:49
#7
Gostushev

проектирование КМ, КМД
 
Регистрация: 02.05.2005
Сообщений: 25


Всем спасибо. Буду тестировать и выказывать недовольство как настоящий заказчик :-). Вы мило друзья общаетесь :-). Всем еще раз спасибо и до новых вам встречь на поле размышлений.
Gostushev вне форума  
 
Непрочитано 08.08.2005, 02:39
#8
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


Разозлил я тебя :?:
Цитата:
Wanna hug?
You think it is time to hug? I not against.

Цитата:
Альтернативные единицы в расейском КМД? Пардоньте-с, но это уже не занудство, но просто - извращение. Такова же извратна есть и проверка на кол-во дечятичных знаков, ибо все размеры - сугубо в мм, что есть целочисленны.
Ну сюда всякий народ заглядывает. Лучше когда написано универсально.
Я тоже сначала написал типа твоего. Но потом понял что лень вдаваться в частности и быстренько накидал вариант по принципу скопировал-взорвал-взял-подтёр. Лень знаешь ли вдаваться во все частности, а оставить как у тебя занудство не даёт
Цитата:
(vla-release ass)
Смешно. Очень даже с юмором, учитывая название переменной и суть функции. Только наверное всё таки:
Код:
[Выделить все]
(vlax-release-object ass)


Ну да ладно. Не буду тебя больше доставать. Тем более что самому далеко до совершенства. Я ж не ShaggyDoc чтобы лекции читать.

С занудским приветом Фантомас
{Smirnoff} вне форума  
 
Непрочитано 26.04.2006, 11:02
#9
serg01


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


а есть такой лисп:
При выделении толпы размеров чтоб значения text override сплюсовались и отобразились в новом размере?
serg01 вне форума  
 
Непрочитано 26.04.2006, 11:15
#10
Кулик Алексей aka kpblc
Moderator

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


А если textoverride нет?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 11:30
#11
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,757


to {Smirnoff}
А можно добавить чтоб все размеры, где нет "<>" закрашивались в определенный цвет. Есть чертежи где уже давно размеры перебиты, а также я могу и без проги что-то написать. Надо покрасить.
Krieger вне форума  
 
Непрочитано 26.04.2006, 11:41
#12
serg01


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


>>kpblc
вообще все размеры забиты вручную. Но если проскочит размер без override, желательно чтоб он подсветился и НЕ посчитался.
ЗЫ. Подсветка должна сработать не зависимо от размерного стиля (даже если в нем стоит другой цвет).
о как!
serg01 вне форума  
 
Непрочитано 26.04.2006, 11:45
#13
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,026


Программа есть Findhanddim.vlx называется от Рипс Э. И erips@yahoo.com Пользуюсь ею.

Скачать можно здесь

http://helpstud.org/load/acad/findhanddim.zip
Хмурый вне форума  
 
Непрочитано 26.04.2006, 11:54
#14
Кулик Алексей aka kpblc
Moderator

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


> Krieger : Попробуй такое:
Код:
[Выделить все]
;|=============================================================================
*    проверка размеров на правильность проставления. Вручную проставленные
* размеры меняют цвет на 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 '((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) "")
	     (/= (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
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 11:58
#15
asys

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


руки бы по самые яйца таким людям поотрывал бы, которые размеры ручками вписывают. :evil: :evil: :evil: Потом концов в проекте не найдешь, откуда лишние метры вылезли. :evil: :evil: :evil:
asys вне форума  
 
Непрочитано 26.04.2006, 12:04
#16
serg01


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


>>Asys
ты по делу бы лучше чего сказал....
serg01 вне форума  
 
Непрочитано 26.04.2006, 12:06
#17
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,026


Цитата:
Сообщение от Asys
руки бы по самые яйца таким людям поотрывал бы, которые размеры ручками вписывают. :evil: :evil: :evil: Потом концов в проекте не найдешь, откуда лишние метры вылезли. :evil: :evil: :evil:
Не забывайте, что есть механики. Чертежи длинномерных деталей выполняются с линиями разрыва. Приходится проставлять размеры вручную...
Хмурый вне форума  
 
Непрочитано 26.04.2006, 12:06
#18
asys

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


Цитата:
Сообщение от serg01
>>Asys
ты по делу бы лучше чего сказал....
по делу ? :arrow: не фиг руками размеры вписывать !!!! Надо чертить ровно !!!!!!!!!
asys вне форума  
 
Непрочитано 26.04.2006, 12:11
#19
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,757


to kpblc
Спасибо, все нормально, только еще два пожелания (если можно):
1. После ввода команды - чтоб не выбирать ничего, а применить сразу ко всем размерам.
2. Если такая запись: "9x<>=6750" то выделять не надо.
Krieger вне форума  
 
Непрочитано 26.04.2006, 12:15
#20
serg01


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


Цитата:
по делу ? Arrow не фиг руками размеры вписывать !!!! Надо чертить ровно !!!!!!!!!
тут модерируется вообще нет? Банить надо всяких шипко умных!
serg01 вне форума  
 
Непрочитано 26.04.2006, 12:32
#21
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от 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
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 12:36
#22
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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,558


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

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


Цитата:
Сообщение от 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
Код на работоспособность не проверял, так что если не работает либо работает неправильно - скажи, буду дальше ковырять
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 13:21
#26
v_alex


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


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

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


у меня это одна из больных тем (после черчения в масштабах конечно)
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
С.-Петербург
Сообщений: 36,674


> serg01 : Давай тогда еще раз ТЗ с самого начала и для тупого. Я уже не могу сегодня нормальный код написать, это факт. Только если завтра.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 16:49
#30
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью 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
С.-Петербург
Сообщений: 36,674


Ну закрутился по работе, бывает, извини. Пробуй:
Код:
[Выделить все]
(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
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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
С.-Петербург
Сообщений: 36,674


Работает как надо?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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
С.-Петербург
Сообщений: 36,674


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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
С.-Петербург
Сообщений: 36,674


В общем несколько вариантов:
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 - быстрее
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 04.05.2006, 03:51
#40
serg01


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


Работает и тот и другой! Спасибо!
serg01 вне форума  
 
Непрочитано 04.05.2006, 08:03
#41
Кулик Алексей aka kpblc
Moderator

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


Ну то, что работает, понятно. Дело в том, что "унутренности" изменивших цвет размеров разные - посмотри ради интересу на них в части цветов текста, выносных и размерных линий.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 02.04.2008, 12:44
#42
gest

GEODATA Engineering S.p.A.
 
Регистрация: 11.02.2005
Монино
Сообщений: 668


Кулик Алексей aka kpblc, не подскажешь, для первого варианта

Цитата:
Команда: dimcheck

Выберите объекты: Противоположный угол: найдено: 1

Выберите объекты:
_.dimlinear
Начало первой выносной линии или <выбрать объект>:
Начало второй выносной линии:
Создан неассоциативный размер.
Положение размерной линии или
[Мтекст/Текст/Угол/Горизонтальный/Вертикальный/Повернутый]:
Размерный текст = 24595
Команда:
То есть надо перемеривать размер?
gest вне форума  
 
Непрочитано 25.02.2009, 11:00
#43
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,363
<phrase 1=


подниму эту тему, ибо нужно немного модифицировать лисп.
1 - при любом изменении вручную размеров в поле текста, нужно просто подчеркнуть текст и все больше никаких телодвижений.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 11.04.2010, 08:15
#44
4eh


 
Регистрация: 07.09.2005
Сообщений: 92
<phrase 1=


Ребята, пожалуйста, измените чуток лисп так, чтобы размеры измененные вручную, окрашивались в другой цвет (даже когда они не byblock), а после иметь возможность вернуть им первоначальный цвет.
4eh вне форума  
 
Непрочитано 26.10.2010, 17:03
#45
Andrey.K


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


Помогите пожалуйста с решением проблемы. Здешние программы посмотрел, но они почему то не все размеры окрашивают - с чем связано - непонятно.
Задача у меня такая. Есть чертеж с кучей размеров, начерченный в масштабе M. Среди них есть размеры нормальные, размеры, вбитые в ручную (не содержат <>), и размеры чей масштаб не соответствует масштабу М. Нужна программа, которая окрасит нормальные размеры в зеленый цвет, не соответствующие масштабу - в красный, вбитые в ручную - оставит как есть.
Работа программы.
Вводим команду, выделяем мышкой область чертежа, при этом выделяются только размеры: линейные, круговые, угловые. Enter.
Размеры, содержащие "<>" стали зеленые, размеры, чей масштаб не соответствует текущей переменной Dimlfac стали красные, остальные - остались без изменений.
Спасибо, если кто поможет.
Andrey.K вне форума  
 
Непрочитано 30.11.2010, 20:05
#46
ALFMario


 
Регистрация: 11.10.2007
Gomel
Сообщений: 68


+1 Программа не окрашивает значение текста размера в другой цвет.
Меняеться цвет примитива, и только в окне цвета, сам примитив остаеться чёрным.
Как сделать так что бы менялся цвет текста размера.
ALFMario вне форума  
 
Непрочитано 30.11.2010, 21:19
#47
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от ALFMario Посмотреть сообщение
Как сделать так что бы менялся цвет текста размера.
Настроить размерный стиль: все примитивы размера должны располагаться на слое "0" и иметь свойства "ByBlock" ("ПоБлоку").
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 01.12.2010, 10:22
#48
ALFMario


 
Регистрация: 11.10.2007
Gomel
Сообщений: 68


Спасибо.
Но достаточно сделать в настройках стиля размера цвет текста по блоку.
ALFMario вне форума  
 
Непрочитано 16.10.2013, 11:18
#49
seregabs


 
Регистрация: 05.03.2012
Санкт-Петербург
Сообщений: 20
<phrase 1=


Добрый день. Извините, что поднимаю.
Есть вопрос по лиспам из постов #3 и #4.
Оба работают.
Но есть еще такое пожелание, чтобы заменяющий текст выделялся цветом (т.е. не весь размер как в одном из лиспов уже сделано, а только текст), например, красным, И был подчеркнутым.
seregabs вне форума  
 
Непрочитано 16.12.2013, 11:49
#50
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,757


Цитата:
Сообщение от seregabs Посмотреть сообщение
Добрый день. Извините, что поднимаю.
Есть вопрос по лиспам из постов #3 и #4.
Оба работают.
Но есть еще такое пожелание, чтобы заменяющий текст выделялся цветом (т.е. не весь размер как в одном из лиспов уже сделано, а только текст), например, красным, И был подчеркнутым.
Код:
[Выделить все]
(defun c:dimr(/ COPYDIM CURLAY DELSET DIMLST
	      DIMSET ERRCOUNT LAYCOL LENT
	      NEXTENT OVTEXT *ERROR* ACTDOC
	      OLDECHO)

  (defun *ERROR* (msg)
    (setvar "CMDECHO" oldEcho)
    ); end of error

  (vl-load-com)
  (setq oldEcho(getvar "CMDECHO")
	actDoc(vla-get-ActiveDocument
		      (vlax-get-acad-object))
	layCol(vla-get-Layers actDoc)
	); end setq
  (setvar "CMDECHO" 0)
  (if
    (setq dimSet
	   (ssget '((0 . "DIMENSION"))))
    (progn
      (setq dimLst
	     (mapcar 'vlax-ename->vla-object 
                    (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex dimSet))))
	    errCount 0
	    ); end setq
      (vla-StartUndoMark actDoc)
      (foreach dim dimLst
	(setq curLay(vla-get-Layer dim))
	(if
	  (/= :vlax-true
	      (vla-get-Lock(Col_Item_Find layCol curLay)))
	  (progn
	(setq lEnt(entlast)
	      delSet(ssadd)
	      copyDim(vla-Copy dim)
	      ); end setq
	(command "_.Explode"(entlast))
	 (setq nextEnt(entnext lEnt))
	(while nextEnt
	  (ssadd nextEnt delSet)
	  (if
	    (member
	      (cdr(assoc 0(entget nextEnt)))
	      '("TEXT" "MTEXT")); end member
	    (setq ovText
		   (cdr(assoc 1(entget nextEnt))))
	    ); end if
	  (command "_.erase" nextEnt "")
	  (setq nextEnt(entnext nextEnt))
	    ); end whlie
	(vla-put-TextOverride dim (strcat "%%u" ovText))
	;(vla-put-Color dim 22)
	(vla-put-TextColor dim 6)
	); end progn
	  (setq errCount(1+ errCount))
	  ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ
	  (strcat "\n"
		  (itoa errCount)" were on locked layer!"))
	); end if
      (vla-EndUndoMark actDoc)
      ); end progn
    ); end if
  (setvar "CMDECHO" oldEcho)
  (princ)
  ); end of c:dimr

(defun Col_Item_Find (Collection Item / result)
  (if
    (not
      (vl-catch-all-error-p  
	(setq result
	       (vl-catch-all-apply 'vla-item
		 (list Collection Item))))) 
    result
    ); end if
  ); end of Col_Item_Find
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 10.02.2014, 10:41
#51
extraneous

Не верблюд
 
Регистрация: 07.06.2010
Москва
Сообщений: 1,135


Подниму тему.
Есть файл с кучей перебитых размеров. Они прекрасно находятся через qselect.
Но есть "1292" перебитый на "1300" (кто-то не умеет пользоваться округлением, да), и "2300" перебитый на "3000". Нужно выделить размеры, в которых реальное значение отличается от "перебитого" больше, чем на некоторое значение.
Может быть, такое уже делали, но не нашел. Если есть - ткните носом.
Думаю такая программа будет полезна не только мне в борьбе с "веселыми картинками".
__________________
Шаблон Revit для разделов КМ/КЖ
extraneous вне форума  
 
Непрочитано 10.02.2014, 13:29
2 | #52
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Как-то так
Код:
[Выделить все]
 (vl-load-com)
(defun digitextract (str / lstdgt digit char i) ;; нарыл в закромах - может и сам написал
  (setq i 1 digit "")
  (repeat (strlen str)
          (setq char (substr str i 1))
          (if 	(and (>= char "0") (<= char "9"))
                (setq digit (strcat digit char))
                (if (or (= char ".") (= char ","))
                    (setq digit (strcat digit "."))
                    (if (= digit ".") (setq digit "") 
                        (if (/= digit "") (setq lstdgt (append lstdgt (list (atof digit))) digit ""))
                        )));end of if*3
          (setq i (1+ i))
          );end of repeat
  (if (and (/= digit ".") (/= digit "")) (setq lstdgt (append lstdgt (list (atof digit)))))
  lstdgt);end of digitextract
(defun test(x)
  ((lambda (ss) 
     (foreach ent 
              (vl-remove-if '(lambda (ent)
                               (or (listp ent)
                                   ((lambda (lst)
                                      ((lambda (dgt)
                                         (or (not dgt)
                                             (<= (abs (- (cdr (assoc 42 lst))
                                                         (car dgt)))
                                                 x)))
                                       (digitextract (cdr (assoc 1 lst)))))
                                    (entget ent))))
                            (mapcar 'cadr (ssnamex (ssget '((0 . "DIMENSION"))))))
              (ssadd ent ss))
     (sssetfirst nil ss)
     (princ))
   (ssadd)))
запускать (test xx) ; где хх - допустимый "разбег"
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 10.02.2014, 14:18
#53
extraneous

Не верблюд
 
Регистрация: 07.06.2010
Москва
Сообщений: 1,135


Дима_, огромное спасибо! Когда будут взвешивать грехи - смело сообщайте, что этот код спас кучу людей от нудного труда
__________________
Шаблон Revit для разделов КМ/КЖ
extraneous вне форума  
 
Непрочитано 17.07.2017, 17:21
#54
v.psk

конструктор
 
Регистрация: 14.08.2014
Псков
Сообщений: 3,490


Похожая задача.
Подскажите пожалуйста, есть ли готовое решение для цепочек размеров:
- хотелось бы чтобы в выбранной группе размеров содержимое перебивалось по условию, например:
для значения 1000 перебивалось на "2х500=<>"
для 1500 "3х500=<>"
для 2000 "4х500=<>"
для 2500 "5х500=<>"
... ну и так далее, пускай даже эти условия будут в теле макроса или лиспа, а при необходимости их надо будет там изменить.
Спасибо.
v.psk вне форума  
 
Непрочитано 17.07.2017, 18:51
1 | #55
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,792
<phrase 1= Отправить сообщение для VVA с помощью Skype™


v.psk, Как-то так в первом приближении
Размеры должны быть не перебитые, а вычисленные
Код:
[Выделить все]
(defun c:DIM= (/ *kpblc-activedoc* ss item rzm count kr)
;;;Команда проставляет в выбранных размерах запрошенную кратность (по умолчанию 500)
;;; Размер должен быть не перебит и кратен кратности500
;;; Если размер кратен 500, то вставляется текст kx500=<>, где
;;; k - посчитанная кратность
  (vl-load-com)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (initget 6)
  (or (setq kr (getint "\nВведите кратность <500>: "))
      (setq kr 500)
    )
  (setq ss (ssget "_:L" '((0 . "DIMENSION"))) count 0)
  (while (and ss
           (> (sslength ss) 0)
       (setq item (ssname ss 0))
       (ssdel item ss)
       ) ;_ end of and
    ;;;(setq item (vlax-ename->vla-object item))
    (setq rzm (atof(vl-string-subst "." "," (dim-get-text-string item))))
    (if (and
	  (zerop (rem rzm kr));;; Делится на kr (500) без остатка, 
	  (> (fix(/ rzm kr)) 1);;; и кратность больше 1
	)
      (setq rzm
         (strcat
          (itoa(fix(/ rzm kr)))
          "x" (itoa kr) "=<>"
          )
	  count (1+ count)  
	)
      (setq rzm nil)
      )
    (if rzm
      (vl-catch-all-apply 'vla-put-textoverride (list (vlax-ename->vla-object item) rzm))
      )
    )
  (vla-endundomark *kpblc-activedoc*)
  (princ "\n==================================")
  (princ "\nИзменено ")(princ count)(princ " размеров")
  (princ " кратность= ")(princ kr)
  (princ)
  ) ;_ end of defun
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  (setq MM Mtext)
  (setq Text "")
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
		   (zerop (strlen Text))
		   (= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text)
(defun dim-get-text-string  ( dim / str)
 (setq str "")
   (vlax-for item (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end of vla-get-Blocks
                       (cdr (assoc 2 (entget dim)))
             ) ;_ end of vla-item
     (if (vlax-property-available-p item 'Textstring)
          (setq str (vla-get-textstring item))
       )
     )
(mip_MTEXT_Unformat str)
  )
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 18.07.2017 в 09:46. Причина: новая версия
VVA вне форума  
 
Непрочитано 17.07.2017, 21:54
#56
v.psk

конструктор
 
Регистрация: 14.08.2014
Псков
Сообщений: 3,490


Цитата:
Сообщение от VVA Посмотреть сообщение
v.psk, Как-то так в первом приближении
Отличная реализация. Спасибо. Багов не нашел.
Хотелось бы из удобства пользования дополнить лисп двумя штуками:
- возможностью ввода из диалогового окна значения этой переменной шага - 500 или другое, удобно если последнее введенное значение будет "по умолчанию"
- подстановка значений выполнялась бы только для выделенных объектов....

Напишу для чего... например при раскладке блоков дополнительного армирования но изополям, их можно наставить примерно, поставив округление в размерах, тогда среди размеров цепочки целые размеры окажутся в габаритных размерах блока, в направлении шага установки арматуры. Их и требуется "перебить". Когда планов много, требуется перебить сотни размеров к виду 5х200=1000 итп..., ну и например образмеривание перфорации теплоизоляционных вкладышей, шага хомутов, закладных, ... итд итп...
v.psk вне форума  
 
Непрочитано 17.07.2017, 22:51
#57
Кулик Алексей aka kpblc
Moderator

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


А сам?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 17.07.2017, 23:09
#58
v.psk

конструктор
 
Регистрация: 14.08.2014
Псков
Сообщений: 3,490


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А сам?
не умею я)))подозреваю, что доработать несложно, поэтому так нагло прошу)
а штука очень полезная
Offtop: был у меня порыв поизучать автолисп несколько лет назад, но увидел эту непонятную структуру со скобками, и перехотел
v.psk вне форума  
 
Непрочитано 18.07.2017, 07:08
#59
lenivec

проектирование
 
Регистрация: 16.09.2005
KZ
Сообщений: 76


Offtop:
Цитата:
Сообщение от v.psk Посмотреть сообщение
был у меня порыв поизучать автолисп несколько лет назад, но увидел эту непонятную структуру со скобками, и перехотел
Математика тоже с такими же скобками
Принцип тот же - сначала считаешь, что во вложенных скобках, потом во внешних, а соседние - по порядку, слева направо.
lenivec вне форума  
 
Непрочитано 18.07.2017, 08:28
1 | #60
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,792
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от v.psk Посмотреть сообщение
Хотелось бы из удобства пользования дополнить лисп двумя штуками:
- возможностью ввода из диалогового окна значения этой переменной шага - 500 или другое, удобно если последнее введенное значение будет "по умолчанию"
- подстановка значений выполнялась бы только для выделенных объектов....
Обновил #55
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.07.2017, 08:38
#61
v.psk

конструктор
 
Регистрация: 14.08.2014
Псков
Сообщений: 3,490


Ещё одна штука всплыла..... Сразу то я не заметил) размеры равные делителю перебивать не требуется, чтобы не появлялись 1*500=500. Спасибо.
v.psk вне форума  
 
Непрочитано 18.07.2017, 09:45
1 | 1 #62
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,792
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от v.psk Посмотреть сообщение
чтобы не появлялись 1*500=500.
Обновил #55
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Новая задачка для ЛИСП умельцев

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

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


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