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

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

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

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

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

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


Г-н 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,392


Цитата:
Лентяй
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,392


Цитата:
Говорили и не раз. Но у всех свои недостатки. Вы как ни кто меня поймете
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
С.-Петербург
Сообщений: 39,787


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

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


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,327


Программа есть Findhanddim.vlx называется от Рипс Э. И [email protected] Пользуюсь ею.

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

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
С.-Петербург
Сообщений: 39,787


> 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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2006, 11:58
#15
asys

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


руки бы по самые яйца таким людям поотрывал бы, которые размеры ручками вписывают. :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,327


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

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


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

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


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


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


Цитата:
по делу ? Arrow не фиг руками размеры вписывать !!!! Надо чертить ровно !!!!!!!!!
тут модерируется вообще нет? Банить надо всяких шипко умных!
serg01 вне форума  
Закрытая тема
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Новая задачка для ЛИСП умельцев

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

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


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