Lisp, меняющий толщины линий

Lisp, меняющий толщины линий · 15.09.2012, 15:10

Добрый день! Много сил и времени нашего отдела тратится на корректировку чужих чертежей (приведение толщин линий в соответствие с внутренними стандартами: Толстая 0,4мм; Тонкая и размеры 0,18мм; Текст, Мтекст 0,2мм). Возможно ли в принципе написать Lisp, меняющий толщины линий следующим образом:
- Все толщины линий до 0,25 включительно преобразовывались бы в 0,18мм.
- Все толщины линий свыше 0,25 преобразовывались бы в 0,4мм.
- Все толщины линий текста и Мтекста преобразовывался в 0,2мм.
- Все толщины линий размеров (параллельные, угловые и т. д. ) - в 0,18мм.

и дополнительно - в слоях - до 0,25 и "по умолчанию" =0,18мм, свыше 0,25 = 0,4мм;
блоки в составах чертежа так же корректировались.
Возможно ли это нажатием одной кнопки?

Do$ · 17.09.2012, 11:41

Возможно.

vade · 20.09.2012, 19:46

Может Do$ подкинет лиспик по этой проблеме

Do$ · 21.09.2012, 08:52

Цитата:

Может Do$ подкинет лиспик по этой проблеме

Откуда такая информация?

vade · 21.09.2012, 20:17

А твоё Возможно разве не о чем не говорит?
Может поможешь с данной проблемой

bargool · 22.09.2012, 16:14

Цитата:

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

А твоё Возможно разве не о чем не говорит?

неа. просто Do$ внимательно читает вопросы))

Цитата:

Сообщение от Конструктор-ППРщик

Возможно ли в принципе написать Lisp,

Цитата:

Сообщение от Конструктор-ППРщик

Возможно ли это нажатием одной кнопки?

в заглавном посте только вот эти два вопроса

Конструктор-ППРщик · 22.09.2012, 16:22

Хорошо, раз возможно, тогда вопрос №2:
Сколько по времени займет сваять такой лиспик и за сколько $ ?

gomer · 22.09.2012, 16:44

Цитата:

Сообщение от Конструктор-ППРщик

колько по времени займет сваять такой лиспик и за сколько $ ?

это в другой раздел

Конструктор-ППРщик · 22.09.2012, 16:45

А если бесплатно, за идею так сказать? )) или хотя бы подскажите чайнику, как его написать?

gomer · 22.09.2012, 16:47

Цитата:

Сообщение от Конструктор-ППРщик

или хотя бы подскажите чайнику, как его написать?

начать с четкого описания алгоритма

MEsher · 24.09.2012, 05:38

Цитата:

Сообщение от Конструктор-ППРщик

- Все толщины линий до 0,25 включительно преобразовывались бы в 0,18мм.
- Все толщины линий свыше 0,25 преобразовывались бы в 0,4мм.
- Все толщины линий текста и Мтекста преобразовывался в 0,2мм.
- Все толщины линий размеров (параллельные, угловые и т. д. ) - в 0,18мм.

То есть вне зависимости от слоя для каждой линии должно выполняться это условие?

Если да, то

Цитата:

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

начать с четкого описания алгоритма

Наверно берешь все объекты с рабочего пространства и по деревянному через 'cond их правишь.

void2005 · 24.09.2012, 07:47

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

MEsher · 24.09.2012, 08:16

Цитата:

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

и по деревянному через 'cond

К примеру так

Код:

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

 (vl-load-com)
(setq acad-application (vlax-get-acad-object))
(setq active-document (vla-get-ActiveDocument acad-application))
(setq model-space (vla-get-ModelSpace active-document))

(defun C:KVESS ( / i temp name)
  (setq i 0)
  (repeat (vla-get-count model-space)
    (setq temp (vla-item model-space i)
	  name (vla-get-objectname temp))
    (cond
      ((= name "AcDbMText") (vla-put-Lineweight temp 20))
      ((= name "AcDbBlockReference") (c:bvess temp))
      ((or (= name "AcDbLine")
	   (= name "AcDbText")
	   (= name "AcDbArc")
	   (= name "AcDbPolyline")
	   (= name "AcDbEllipse")
	   (= name "AcDbHatch")
	   (= name "AcDbSpline")
	   (= name "AcDbCircle")) (vla-put-Lineweight temp
				    (if (<= (vla-get-Lineweight temp) 25) 18 40)))
      ((wcmatch name "*Dimension") (vla-put-Lineweight temp 18))
      (T (princ "Неизвестный примитив :(")))
    (setq i (1+ i))))

(defun c:BVESS (block / temp i name)
  (setq block (vla-item (vla-get-blocks active-document) (vla-get-EffectiveName block))
	i 0)
  (repeat (vla-get-count block)
    (setq temp (vla-item block i)
	  name (vla-get-objectname temp))
    (cond
      ((= name "AcDbMText") (vla-put-Lineweight temp 20))
      ((= name "AcDbBlockReference") (c:bvess temp))
      ((or (= name "AcDbLine")
	   (= name "AcDbText")
	   (= name "AcDbArc")
	   (= name "AcDbPolyline")
	   (= name "AcDbEllipse")
	   (= name "AcDbHatch")
	   (= name "AcDbSpline")
	   (= name "AcDbCircle")) (vla-put-Lineweight temp
				    (if (<= (vla-get-Lineweight temp) 25) 18 40)))
      (T (princ "Неизвестный примитив :(")))
    (setq i (1+ i))
    ))

Кулик Алексей aka kpblc · 24.09.2012, 09:08

Ака крыс сейчас в завале. Ни на что полноценное времени нет. А выдавать полуфабрикат - не комильфо.

MEsher · 25.09.2012, 06:53

хотя можно и иначе попробывать

Код:

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

 
(vl-load-com)

(defun C:NVESS (/ acad-application active-document model-space nvess)
  (setq	acad-application (vlax-get-acad-object)
	active-document	 (vla-get-ActiveDocument acad-application)
	model-space	 (vla-get-ModelSpace active-document)
	nvess		 (lambda (space / temp ind)
			   (setq ind (vla-get-count space))
			   (repeat (vla-get-count space)
			     (setq temp (vla-item space (1- ind)))
			     (if (= (vla-get-objectname temp) "AcDbBlockReference")
			       (progn
				 (nvess (vla-item (vla-get-blocks active-document)
						 (vla-get-EffectiveName temp)
				       )
				 )
				 (nvess (vla-item (vla-get-blocks active-document)
						 (vla-get-Name temp)
				       )
				 )
			       )

			       (if (vlax-property-available-p temp "Lineweight")
				 (if
				   (wcmatch (vla-get-objectname temp)
					    "*Text,AcDbAttribute,AcDbAttributeDefinition"
				   )
				    (vla-put-Lineweight temp 20)
				    (vla-put-Lineweight
				      temp
				      (if (<= (vla-get-Lineweight temp) 25)
					18
					40
				      )
				    )
				 )
			       )
			     )
			     (setq ind (1- ind))
			   )
			 )
  )
  (nvess model-space)
)

Кулик Алексей aka kpblc · 25.09.2012, 09:40

Без гарантий и особых проверок:

Код:

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

 (vl-load-com)

(defun c:test (/ adoc layers att)

  (defun _kpblc-conv-ent-to-vla (ent_value / res)
    (cond
      ((= (type ent_value) 'vla-object) ent_value)
      ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
      ((setq res (_kpblc-conv-ent-to-ename ent_value))
       (vlax-ename->vla-object res)
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-ename (ent_value /)
    (cond
      ((= (type ent_value) 'vla-object)
       (vlax-vla-object->ename ent_value)
       )
      ((= (type ent_value) 'ename) ent_value)
          ;((= (type ent_value) 'str) (handent ent_value))
      ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
    (cond
      ((listp value)
       (mapcar (function _kpblc-conv-vla-to-list) value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (member (type value) (list 'ename 'str 'vla-object))
            (= (type (_kpblc-conv-ent-to-vla value)) 'vla-object)
            (vlax-property-available-p (_kpblc-conv-ent-to-vla value) 'count)
            ) ;_ end of and
       (vlax-for sub (_kpblc-conv-ent-to-vla value)
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun


  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq layers (mapcar
                 (function
                   (lambda (x)
                     (append (list (cons "obj" x))
                             (mapcar
                               (function
                                 (lambda (prop / tmp)
                                   (setq tmp (vlax-get-property x (car prop)))
                                   (vl-catch-all-apply
                                     (function
                                       (lambda ()
                                         (vlax-put-property x (car prop) (cdr prop))
                                         ) ;_ end of lambda
                                       ) ;_ end of function
                                     ) ;_ end of vl-catch-all-apply
                                   (cons (car prop) tmp)
                                   ) ;_ end of lambda
                                 ) ;_ end of function
                               (list (cons "freeze" :vlax-false)
                                     (cons "lock" :vlax-false)
                                     ) ;_ end of list
                               ) ;_ end of mapcar
                             ) ;_ end of append
                     ) ;_ end of LAMBDA
                   ) ;_ end of function
                 (vl-remove-if
                   (function
                     (lambda (x)
                       (wcmatch (strcase (vla-get-name x)) "*|*")
                       ) ;_ end of LAMBDA
                     ) ;_ end of function
                   (_kpblc-conv-vla-to-list (vla-get-layers adoc))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
        ) ;_ end of setq
  (foreach item layers
    (vla-put-lineweight (cdr (assoc "obj" item))
                        (if (or (= (vla-get-lineweight (cdr (assoc "obj" item))) aclnwtbylwdefault)
                                (<= (vla-get-lineweight (cdr (assoc "obj" item))) aclnwt025)
                                ) ;_ end of or
                          aclnwt018
                          aclnwt040
                          ) ;_ end of if
                        ) ;_ end of vla-put-lineweight
    ) ;_ end of foreach
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (equal (vla-get-isxref blk_def) :vlax-false)
      (if (wcmatch (if (vlax-property-available-p blk_def 'effectivename)
                     (vla-get-effectivename blk_def)
                     (vla-get-name blk_def)
                     ) ;_ end of if
                   "`*D*"
                   ) ;_ end of WCMATCH
        (vlax-for ent blk_def
          (vl-catch-all-apply
            (function
              (lambda ()
                (vla-put-lineweight ent aclnwt018)
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vlax-for
        (vlax-for ent blk_def
          (if (and (wcmatch (strcase (vla-get-objectname ent)) "*BLOCK*")
                   (setq att (append (_kpblc-conv-vla-to-list (vla-getattributes ent))
                                     (_kpblc-conv-vla-to-list (vla-getconstantattributes ent))
                                     ) ;_ end of append
                         ) ;_ end of setq
                   ) ;_ end of and
            (foreach _att att
              (vl-catch-all-apply
                (function
                  (lambda ()
                    (vla-put-lineweight _att aclnwt020)
                    ) ;_ end of lambda
                  ) ;_ end of function
                ) ;_ end of vl-catch-all-apply
              ) ;_ end of foreach
            ) ;_ end of if
          (vl-catch-all-apply
            (function
              (lambda ()
                (vla-put-lineweight ent
                                    (cond
                                      ((wcmatch (strcase (vla-get-objectname ent)) "*TEXT,*ATTR*") aclnwt020)
                                      ((<= (vla-get-lineweight ent) aclnwt025) aclnwt018)
                                      (t aclnwt040)
                                      ) ;_ end of cond
                                    ) ;_ end of vla-put-lineweight
                ) ;_ end of LAMBDA
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vlax-for
        ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of vlax-for
  (foreach item layers
    (foreach prop (cdr item)
      (vl-catch-all-apply
        (function
          (lambda ()
            (vlax-put-property (cdr (assoc "obj" item)) (car prop) (cdr prop))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of foreach
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Дима_ · 25.09.2012, 10:55

Offtop: То Крыс - кодировка

Кулик Алексей aka kpblc · 25.09.2012, 10:59

А она касалась только комментариев. Вроде посносил.
Но все равно спасибо

detrah · 26.09.2012, 14:32

Похожая задача: необходимо для выбранных примитивов изменить вес линии.
Наковырял только такое (для одного примитива):

Код:

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

 ; Присваиваем объекту вес линии
(defun c:lweight05 (/ ent)
   (setvar "CMDECHO" 0)
   (setq ent (vlax-ename->vla-object (car (entsel))))
   (vla-put-lineweight ent aclnwt050); вес в мм*100
   (princ)
 )

Подскажите, как модернизировать код, чтобы можно было редактировать сразу целый набор?

Саша1983 · 26.09.2012, 16:14

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

15.09.2012, 15:10		#1
Lisp, меняющий толщины линий Конструктор-ППРщик https://t.me/km_kmd_service Регистрация: 06.05.2010 Сообщений: 95 Добрый день! Много сил и времени нашего отдела тратится на корректировку чужих чертежей (приведение толщин линий в соответствие с внутренними стандартами: Толстая 0,4мм; Тонкая и размеры 0,18мм; Текст, Мтекст 0,2мм). Возможно ли в принципе написать Lisp, меняющий толщины линий следующим образом: - Все толщины линий до 0,25 включительно преобразовывались бы в 0,18мм. - Все толщины линий свыше 0,25 преобразовывались бы в 0,4мм. - Все толщины линий текста и Мтекста преобразовывался в 0,2мм. - Все толщины линий размеров (параллельные, угловые и т. д. ) - в 0,18мм. и дополнительно - в слоях - до 0,25 и "по умолчанию" =0,18мм, свыше 0,25 = 0,4мм; блоки в составах чертежа так же корректировались. Возможно ли это нажатием одной кнопки? Последний раз редактировалось Конструктор-ППРщик, 15.09.2012 в 15:24.
Просмотров: 7111

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP для подсчета суммы длин линий	Kostinok	LISP	18	26.04.2013 14:56
LISP. Как увеличить уменьшить масштаб типов линий всех объектов на заданную величину.	Zhnek	LISP	4	26.07.2012 12:37
LISP Есть дерево из линий, нужно на концы линий нарисовать метки	Golem-iq	LISP	16	06.03.2012 00:44
AutoCAD 2011: отображение толщины линий	dimcher	AutoCAD	2	18.05.2010 12:33
Печать толщины линий	Alexfoto333	AutoCAD	3	10.10.2007 11:06

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