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

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

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

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

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

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


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

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


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

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

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

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

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


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


 
Регистрация: 07.09.2005
Сообщений: 97
<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
С.-Петербург
Сообщений: 39,787


Цитата:
Сообщение от ALFMario Посмотреть сообщение
Как сделать так что бы менялся цвет текста размера.
Настроить размерный стиль: все примитивы размера должны располагаться на слое "0" и иметь свойства "ByBlock" ("ПоБлоку").
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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,825


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


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

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


Как-то так
Код:
[Выделить все]
 (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,152


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

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


Похожая задача.
Подскажите пожалуйста, есть ли готовое решение для цепочек размеров:
- хотелось бы чтобы в выбранной группе размеров содержимое перебивалось по условию, например:
для значения 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,990
<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
Псков
Сообщений: 7,096


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


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

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


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

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


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

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


Цитата:
Сообщение от v.psk Посмотреть сообщение
Хотелось бы из удобства пользования дополнить лисп двумя штуками:
- возможностью ввода из диалогового окна значения этой переменной шага - 500 или другое, удобно если последнее введенное значение будет "по умолчанию"
- подстановка значений выполнялась бы только для выделенных объектов....
Обновил #55
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Закрытая тема
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Новая задачка для ЛИСП умельцев

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

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


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