Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Перевод всех блоков в слой "0"
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Блоки созданы изначально не в слое "0" (каждый в своем слое). А затем из этих некорректных блоков создан следующий блок.
Разумеется можно отредактировать стандартными командами Автокада.
Но может быть кто-нибудь богат лиспом на этот случай, или ссылкой на сайт.
Если я правильно понял необходимо переопределить все вложеные блоки, тогда если блок Х в блоке М переводится в слой "0", то на всем чертеже блок Х будет в слое "0;
Если это то что нужно:
Вызов функции:
(qF_ExecuteBlockToLayer ENAME "0")
(defun qF_dxf (q_code q_list) (cdr (assoc q_code q_list)))
(defun qF_what_object (x) (cdr (assoc 0 (entget x))))
(defun qF_ListOneLevel (q_ListOr / q_el q_Str)
(setq q_Str ())
(foreach q_el q_ListOr
(setq q_Str (append q_Str
(cond
((and (eq (type q_el) 'LIST)(eq (type (car q_el)) 'LIST)) (qF_ListOneLevel q_el))
((And q_el (/= (type q_el) 'LIST))(list (list q_el)))
(t (list q_el))))))
q_Str)
(defun qF_GetBlockContent1 (q_BlockName / q_list1 q_block q_ent1)
(setq q_list1())
(if (setq q_block (tblsearch "block" q_BlockName))
(progn
(setq q_ent1 (q_dxf -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)))))
q_list1)
(defun qF_GetBlockContent2 (q_ent / q_list1 q_block q_ent1)
(setq q_list1()
q_BlockName (qF_Dxf 2 (entget q_ent)))
(if (setq q_block (tblsearch "block" q_BlockName))
(progn
(setq q_ent1 (q_dxf -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)))))
q_list1)
(defun qF_GetBlockContent4 (q_ent / q_list1 q_block q_ent1 q_EntGet1)
(setq q_EntGet1 (entget q_ent))
(list
(list "INSERT" q_ent)
(qF_GetBlockContent2 q_ent)))
(defun qF_GetBlockDeep (q_ent / q_v q_t)
(setq q_t (qF_GetBlockContent4 q_ent))
(vl-list* (car q_t)
(mapcar '(lambda (q_v)
(if (= (qF_what_object q_v) "INSERT")(qF_GetBlockDeep q_v) q_v))
(cadr q_t))))
(Defun qF_ExecuteBlockToLayer (q_Block q_LayerName / q_BlockNameList1 q_EntGet)
(setq q_BlockNameList (mapcar '(lambda (q_v1)(qF_Dxf 2 (entget q_v1)))
(mapcar 'cadr (vl-remove-if '(lambda (q_v) (/= (car q_v) "INSERT")) (qF_ListOneLevel (qF_GetBlockDeep q_Block)))))
q_BlockNameList1 ())
(while (Setq q_nth (car q_BlockNameList))
(setq q_BlockNameList (vl-remove q_nth q_BlockNameList)
q_BlockNameList1 (append q_BlockNameList1 (list q_nth))))
(foreach q_v q_BlockNameList1
(foreach q_v1 (qF_GetBlockContent1 q_v)
(setq q_EntGet (entget q_v1))
(entmod (subst (cons 8 q_LayerName)(assoc 8 q_EntGet) q_EntGet))
(entupd q_v1))))
(qF_ExecuteBlockToLayer ENAME "0")> PalStudio
После команды Load Application выдает ошибку : "; error: too many arguments".
Буду Вам благодарна, если это возможно исправить.
В любом случае спасибо. Есть материал для исследований.
Кто автор не знаю (стыдно), но где то здесь на форуме выложено:
(defun c:btz (/
opMode
Block
vlaList
actDoc
layerState
LayerCol
nameList
layList
blockCol
blSet
)
(vl-load-com)
(initget "L B C")
(setq opMode
(getkword "Select output block(s) color [byLayer/byBlock/Current]<L>: "))
(if(null opMode)(setq opMode "L"))
(princ "\nSelect block(s) and press Enter ")
(setq blSet(ssget '((0 . "INSERT"))))
(if blSet
(progn
(setq actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
LayerCol(vla-get-Layers actDoc)
layerState '()
vlaList(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex blSet))))
nameList
(mapcar
'(lambda (x)(vla-get-Name x))vlaList)
layList
(mapcar '(lambda(x)
(list x(vla-get-Layer x)(vla-get-Color x)))vlaList)
blockCol
(vla-get-blocks actDoc)
); end setq
(vlax-for l LayerCol
(setq layerState
(append layerState
(list
(list
l
(vla-get-Lock l)))))
(vla-put-lock l :vlax-false)
); end vlax-for
(vlax-for i blockCol
(vlax-for e i
(if
(member (vla-get-Name i)nameList)
(progn
(vla-put-Layer e "0")
(vla-put-Color e 0)
); end progn
); end if
); end vlax-for
); end vlax-for
(foreach i layList
(vla-put-Layer(car i)(cadr i))
(cond
((= opMode "L")(vla-put-Color(car i)256))
((= opMode "B")(vla-put-Color(car i)0))
((= opMode "C")(vla-put-Color(car i)(nth 2 i)))
); end cond
); end foreach
(foreach l layerState
(vla-put-Lock (car l)(cadr l))
); end foreach
); end progn
(princ "\nNothing block selected!")
); end if
(vla-regen actDoc acAllViewports)
(princ)
); end of btz > Inna
Oops, sorry
перепутал имя функции.
сейчас должно быть все нормально
(defun qF_dxf (q_code q_list) (cdr (assoc q_code q_list)))
(defun qF_what_object (x) (cdr (assoc 0 (entget x))))
(defun qF_ListOneLevel (q_ListOr / q_el q_Str)
(setq q_Str ())
(foreach q_el q_ListOr
(setq q_Str (append q_Str
(cond
((and (eq (type q_el) 'LIST)(eq (type (car q_el)) 'LIST)) (qF_ListOneLevel q_el))
((And q_el (/= (type q_el) 'LIST))(list (list q_el)))
(t (list q_el))))))
q_Str)
(defun qF_GetBlockContent1 (q_BlockName / q_list1 q_block q_ent1)
(setq q_list1())
(if (setq q_block (tblsearch "block" q_BlockName))
(progn
(setq q_ent1 (QF_DXF -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)))))
q_list1)
(defun qF_GetBlockContent2 (q_ent / q_list1 q_block q_ent1)
(setq q_list1()
q_BlockName (qF_Dxf 2 (entget q_ent)))
(if (setq q_block (tblsearch "block" q_BlockName))
(progn
(setq q_ent1 (QF_DXF -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)))))
q_list1)
(defun qF_GetBlockContent4 (q_ent / q_list1 q_block q_ent1 q_EntGet1)
(setq q_EntGet1 (entget q_ent))
(list
(list "INSERT" q_ent)
(qF_GetBlockContent2 q_ent)))
(defun qF_GetBlockDeep (q_ent / q_v q_t)
(setq q_t (qF_GetBlockContent4 q_ent))
(vl-list* (car q_t)
(mapcar '(lambda (q_v)
(if (= (qF_what_object q_v) "INSERT")(qF_GetBlockDeep q_v) q_v))
(cadr q_t))))
(Defun qF_ExecuteBlockToLayer (q_Block q_LayerName / q_BlockNameList1 q_EntGet)
(setq q_BlockNameList (mapcar '(lambda (q_v1)(qF_Dxf 2 (entget q_v1)))
(mapcar 'cadr (vl-remove-if '(lambda (q_v) (/= (car q_v) "INSERT")) (qF_ListOneLevel (qF_GetBlockDeep q_Block)))))
q_BlockNameList1 ())
(while (Setq q_nth (car q_BlockNameList))
(setq q_BlockNameList (vl-remove q_nth q_BlockNameList)
q_BlockNameList1 (append q_BlockNameList1 (list q_nth))))
(foreach q_v q_BlockNameList1
(foreach q_v1 (qF_GetBlockContent1 q_v)
(setq q_EntGet (entget q_v1))
(entmod (subst (cons 8 q_LayerName)(assoc 8 q_EntGet) q_EntGet))
(entupd q_v1))))
;(qF_ExecuteBlockToLayer ENAME "0")
(qF_ExecuteBlockToLayer (car (entsel)) "0")> Inna
Дополнение.
Наберите в коммандной строке ChangeTo0
(Defun c:ChangeTo0 ()
(foreach q_blbl (mapcar 'cadr (ssnamex (ssget "X" '((0 . "INSERT")))))
(qF_ExecuteBlockToLayer q_blbl "0")))> PalStudio
>pavel
СПАСИБО!!! Замечательно! Работает!
Может быть станет более понятна моя дотошность, но я готовлю данный проблемный чертеж к плоту и все что сделано блоками д.б. фоном в одном цвете. А после обработки чертежа вашими программами, оказалось что еще и все атрибуты в данных блоках - каждый в своем цвете (использованы почти все 255 цвета).
Если уже есть что-нибудь готовое, киньте пожалуйста.
Чтобы с минимальными переделками (мне, если честно, лень все переписывать на новые задачи):
(defun qf_dxf (q_code q_list)
(cdr (assoc q_code q_list))
) ;_ end of defun
(defun qf_what_object (x)
(cdr (assoc 0 (entget x)))
) ;_ end of defun
(defun qf_listonelevel (q_listor / q_el q_str)
(setq q_str ())
(foreach q_el q_listor
(setq q_str
(append q_str
(cond
((and (eq (type q_el) 'list) (eq (type (car q_el)) 'list))
(qf_listonelevel q_el)
)
((and q_el (/= (type q_el) 'list)) (list (list q_el)))
(t (list q_el))
) ;_ end of cond
) ;_ end of append
) ;_ end of setq
) ;_ end of foreach
q_str
) ;_ end of defun
(defun qf_getblockcontent1 (q_blockname / q_list1 q_block q_ent1)
(setq q_list1 ())
(if (setq q_block (tblsearch "block" q_blockname))
(progn
(setq q_ent1 (qf_dxf -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)
) ;_ end of setq
) ;_ end of while
) ;_ end of progn
) ;_ end of if
q_list1
) ;_ end of defun
(defun qf_getblockcontent2 (q_ent / q_list1 q_block q_ent1)
(setq q_list1 ()
q_blockname
(qf_dxf 2 (entget q_ent))
) ;_ end of setq
(if (setq q_block (tblsearch "block" q_blockname))
(progn
(setq q_ent1 (qf_dxf -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)
) ;_ end of setq
) ;_ end of while
) ;_ end of progn
) ;_ end of if
q_list1
) ;_ end of defun
(defun qf_getblockcontent4 (q_ent / q_list1 q_block q_ent1 q_entget1)
(setq q_entget1 (entget q_ent))
(list
(list "INSERT" q_ent)
(qf_getblockcontent2 q_ent)
) ;_ end of list
) ;_ end of defun
(defun qf_getblockdeep (q_ent / q_v q_t)
(setq q_t (qf_getblockcontent4 q_ent))
(vl-list* (car q_t)
(mapcar '(lambda (q_v)
(if (= (qf_what_object q_v)
"INSERT"
) ;_ end of =
(qf_getblockdeep q_v)
q_v
) ;_ end of if
) ;_ end of lambda
(cadr q_t)
) ;_ end of mapcar
) ;_ end of vl-list*
) ;_ end of defun
(defun qf_executeblocktolayer (q_block q_layername / q_blocknamelist1 q_entget)
(setq q_blocknamelist (mapcar '(lambda (q_v1)
(qf_dxf 2
(entget
q_v1
) ;_ end of entget
) ;_ end of qF_Dxf
) ;_ end of lambda
(mapcar 'cadr
(vl-remove-if
'(lambda (q_v)
(/= (car q_v)
"INSERT"
) ;_ end of /=
) ;_ end of lambda
(qf_listonelevel (qf_getblockdeep q_block))
) ;_ end of vl-remove-if
) ;_ end of mapcar
) ;_ end of mapcar
q_blocknamelist1 ()
) ;_ end of setq
(while (setq q_nth (car q_blocknamelist))
(setq q_blocknamelist (vl-remove q_nth q_blocknamelist)
q_blocknamelist1 (append q_blocknamelist1 (list q_nth))
) ;_ end of setq
) ;_ end of while
(foreach q_v q_blocknamelist1
(foreach q_v1 (qf_getblockcontent1 q_v)
(setq q_entget (entget q_v1))
(entmod (subst (cons 62 q_layername)
(assoc 62 q_entget)
q_entget
) ;_ end of subst
) ;_ end of entmod
(entupd q_v1)
) ;_ end of foreach
) ;_ end of foreach
) ;_ end of Defun
(defun c:ch-color ()
(foreach q_blbl (mapcar 'cadr
(ssnamex (ssget "X" '((0 . "INSERT"))))
) ;_ end of mapcar
(qf_executeblocktolayer q_blbl 256)
) ;_ end of foreach
) ;_ end of DefunАй-яй-яй, про аттривуты забыли
две новые функции
(defun qF_ExtractAttr (q_block / q_ent q_list q_e)
(setq q_ent (entget q_block) q_list ())
(if (eq (qf_dxf 66 q_ent) 1)
(progn
(setq q_e (entnext (qf_dxf -1 q_ent)))
(while (and (eq (qf_dxf 330 (entget q_e)) q_block) (eq (qf_dxf 0 (entget q_e)) "ATTRIB"))
(setq q_list (append q_list (list q_e)))
(setq q_e (entnext (qf_dxf -1 (entget q_e)))))))
q_list)
(defun qF_ChangeColorLayer (q_EntGet q_LayerName q_Color)
(if (eq 'ENAME (type q_EntGet))(setq q_EntGet (entget q_EntGet '("*"))))
(if q_LayerName (setq q_EntGet (subst (cons 8 q_LayerName)(assoc 8 q_EntGet) q_EntGet)))
(if q_Color
(setq q_EntGet (vl-remove-if '(lambda (q_v) (= (car q_v) 62)) q_EntGet)
q_EntGet (append q_EntGet (list (cons 62 q_Color)))))
q_EntGet)и две переделанные
(Defun qF_ExecuteBlockToLayer (q_Block q_LayerName q_Color / q_BlockNameList1 q_EntGet q_t)
(setq q_BlockNameList (mapcar 'cadr (vl-remove-if '(lambda (q_v) (/= (car q_v) "INSERT"))(qF_ListOneLevel (qF_GetBlockDeep q_Block)))))
(foreach q_v2 q_BlockNameList
(if (setq q_t1 (qF_ExtractAttr q_v2))
(foreach q_v3 q_t1
(entmod (qF_ChangeColorLayer q_v3 q_LayerName q_Color)))))
(setq q_BlockNameList (mapcar '(lambda (q_v1)(qF_Dxf 2 (entget q_v1))) q_BlockNameList)
q_BlockNameList1 ())
(while (Setq q_nth (car q_BlockNameList))
(setq q_BlockNameList (vl-remove q_nth q_BlockNameList)
q_BlockNameList1 (append q_BlockNameList1 (list q_nth))))
(foreach q_v q_BlockNameList1
(foreach q_v1 (qF_GetBlockContent1 q_v)
(entmod (qF_ChangeColorLayer q_v1 q_LayerName q_Color))
(entupd q_v1))))
(Defun c:ChangeTo0 ( / q_LayerName q_Color)
(Setq q_LayerName "0"
q_Color 256)
(Command "_.Layer" "U" "*" "")
(Command "_.Chprop" (ssget "X" '((0 . "INSERT"))) "" "LA" q_LayerName "CO" (if (= q_Color 256) "Bylayer" q_Color) "")
(foreach q_blbl (mapcar 'cadr (ssnamex (ssget "X" '((0 . "INSERT")))))
(qF_ExecuteBlockToLayer q_blbl q_LayerName q_Color))
(Command "_.REGENALL"))Спасибо всем огромное!!!
Для тех кто захочет воспользоваться этими программами - результат тестирования:
Программа PalStudio:
Во всем чертеже заменяет слой создания блоков и атрибутов на слой "0" и цвет "по-слою". Затем переводит все блоки в слой "0".
Работает!
Программа kpblc:
Во всем чертеже заменяет слой создания блоков и атрибутов на слой "0" и цвет "по-слою". Оставляет сами блоки в их слое, что позволяет в дальнейшем оперировать цветом слоя блока в Layer Manager.
Работает!
>pavel
Блоки переводит в слой "0" и цвет "по-слою", а вот атрибуты остаются каждый в своем цвете. Но работает быстро и по выбору конкретных блоков, что тоже иногда необходимо.
Кроме проблем с цветом атрибутов работает.
И во всех вариантах неверный подход - цвет примитивов блока надо делать не "послою", а "поблоку". И другие видимые свойства - тип линии, вес линии.
В этом случае вставка блока будет принимать и свойства слоя, на который вставлена, и вставке блока могут быть назначены индивидуальные свойства, как любому примитиву.
> Inna
"ByLayer"? Вообще-то делал "ByBlock" - в функции изменения кода 62 стоит значение 256. На самом деле тут ситуация немного другая. Я не переделывал код!!! Поэтому функции могут повторяться. Для гарантии проверьте код
(defun _change-color ()
;; Локальные функции
(defun _qf_dxf (q_code q_list)
(cdr (assoc q_code q_list))
) ;_ end of defun
(defun _qf_what_object (x)
(cdr (assoc 0 (entget x)))
) ;_ end of defun
(defun _qf_listonelevel (q_listor / q_el q_str)
(setq q_str ())
(foreach q_el q_listor
(setq q_str
(append q_str
(cond
((and (eq (type q_el) 'list)
(eq (type (car q_el))
'list
) ;_ end of eq
) ;_ end of and
(_qf_listonelevel q_el)
)
((and q_el (/= (type q_el) 'list)) (list (list q_el)))
(t (list q_el))
) ;_ end of cond
) ;_ end of append
) ;_ end of setq
) ;_ end of foreach
q_str
) ;_ end of defun
(defun _qf_getblockcontent1 (q_blockname / q_list1 q_block q_ent1)
(setq q_list1 ())
(if (setq q_block (tblsearch "block" q_blockname))
(progn
(setq q_ent1 (_qf_dxf -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)
) ;_ end of setq
) ;_ end of while
) ;_ end of progn
) ;_ end of if
q_list1
) ;_ end of defun
(defun _qf_getblockcontent2 (q_ent / q_list1 q_block q_ent1)
(setq q_list1 ()
q_blockname
(_qf_dxf 2 (entget q_ent))
) ;_ end of setq
(if (setq q_block (tblsearch "block" q_blockname))
(progn
(setq q_ent1 (_qf_dxf -2 q_block))
(while q_ent1
(setq q_list1 (append q_list1 (list q_ent1))
q_ent1 (entnext q_ent1)
) ;_ end of setq
) ;_ end of while
) ;_ end of progn
) ;_ end of if
q_list1
) ;_ end of defun
(defun _qf_getblockcontent4 (q_ent / q_list1 q_block q_ent1 q_entget1)
(setq q_entget1 (entget q_ent))
(list
(list "INSERT" q_ent)
(_qf_getblockcontent2 q_ent)
) ;_ end of list
) ;_ end of defun
(defun _qf_getblockdeep (q_ent / q_v q_t)
(setq q_t (_qf_getblockcontent4 q_ent))
(vl-list* (car q_t)
(mapcar '(lambda (q_v)
(if (= (_qf_what_object q_v)
"INSERT"
) ;_ end of =
(_qf_getblockdeep q_v)
q_v
) ;_ end of if
) ;_ end of lambda
(cadr q_t)
) ;_ end of mapcar
) ;_ end of vl-list*
) ;_ end of defun
(defun _qf_executeblocktolayer
(q_block q_layername / q_blocknamelist1 q_entget)
(setq q_blocknamelist (mapcar
'(lambda (q_v1)
(_qf_dxf 2
(entget
q_v1
) ;_ end of entget
) ;_ end of _qf_dxf
) ;_ end of lambda
(mapcar 'cadr
(vl-remove-if
'(lambda (q_v)
(/= (car q_v)
"INSERT"
) ;_ end of /=
) ;_ end of lambda
(_qf_listonelevel (_qf_getblockdeep q_block))
) ;_ end of vl-remove-if
) ;_ end of mapcar
) ;_ end of mapcar
q_blocknamelist1 ()
) ;_ end of setq
(while (setq q_nth (car q_blocknamelist))
(setq q_blocknamelist (vl-remove q_nth q_blocknamelist)
q_blocknamelist1 (append q_blocknamelist1 (list q_nth))
) ;_ end of setq
) ;_ end of while
(foreach q_v q_blocknamelist1
(foreach q_v1 (_qf_getblockcontent1 q_v)
(setq q_entget (entget q_v1))
(entmod (subst (cons 62 q_layername)
(assoc 62 q_entget)
q_entget
) ;_ end of subst
) ;_ end of entmod
(entupd q_v1)
) ;_ end of foreach
) ;_ end of foreach
) ;_ end of Defun
;; Конец локальных функций
(foreach q_blbl (mapcar 'cadr
(ssnamex (ssget "X" '((0 . "INSERT"))))
) ;_ end of mapcar
(_qf_executeblocktolayer q_blbl 256)
) ;_ end of foreach
) ;_ end of Defun
(defun c:ch-color ()
(_change-color)
) ;_ end of defunТам проблема в том, что одно и то же имя использовалось для разных целей. И выполняли разные действия. Тут по идее спрятано все так, чтобы не мешалось. Заодно и имена функций поменял.
P.S. Я не проверял работоспособность кода, сорри
> ShaggyDoc
А что делать с многократно-вложенными блоками?
> kpblc
И все-таки "ByLayer".
А меня устраивает. Спасибо!
> ShaggyDoc
Если Вы внимательней исследуете варианты предложенных программ, то заметите что проблема многократно вложенных блоков тоже решается (если я Вас правильно поняла, Вы имеете ввиду блок в блоке).
С удовольствием протестирую Ваш вариант.
Если Вы внимательней исследуете варианты предложенных программ, то заметите что проблема многократно вложенных блоков тоже решается (если я Вас правильно поняла, Вы имеете ввиду блок в блоке).
Я не имею ввиду вложенность блоков. О вложенности у меня ни слова. Общий подход - свойства примитивов блока должны быть ByBlock. В частном случае Вас может устроить и ByLayer, но для универсальности должно быть ByBlock.
Это относится к блокам, которые специально создаются для многократного применения. "Случайные" блоки, образующиеся, например, при вставке целого чертежа, под это не попадают. Естественно, что у них примитивы могут иметь любые свойства.
Код я не исследовал (незачем) - воспользовался Вашим выводом в Inna (2005-10-04 21:48:52).
> kpblc
>PalStudio
ребята перепуталось все, можно для дураков еще раз (ведь очень нужно, не забавы зря), последний вариант программы полностью, и как запускать:
(qF_ExecuteBlockToLayer ENAME "0")?
ChangeTo0 ?
(_change-color) ?
(если важно под каким именем сохранять lisp).
Не работает ничего.
> pavel
Ну для моего варианта запуск с ком.строки ch-color. Например, сохранил код как "ch-color.lsp", и на кнопку вешается макрос типа
^C^C(if (null "c:ch-color") (load "ch-color.lsp"));ch-color;
Это для варианта файла по путям поддержки када. Если папка, куда сохранили, не описана в путях поддержки (просмотреть и изменить можно через Options -> Files -> Support files path), то код станет (для варианта "сохранили в d:\lib\blocks\lsp\ch-color.lsp"):
^C^C(if (null "c:ch-color") (load "d:\\lib\\blocks\\lsp\\ch-color.lsp"));ch-color;
Если код не срабатывает, то замени в нем "\\" на "/".
По-моему, так.
> kpblc
Заменил \\ на / как сказано, все равно к сожелению получаю только:
Command: (if (null "c:ch-color") (load "ch-color.lsp"))
nil
или:
Command: ch-color
nil
ничего не происходит, жаль...
> pavel
>(qF_ExecuteBlockToLayer ENAME "0")
в > PalStudio (2005-10-04 19:11:28)
функция qF_ExecuteBlockToLayer выглядить так
(qF_ExecuteBlockToLayer Block LayerName Color)
У вас пропущен параметр, можно вместо LayerName или Color указать nil.
Посколько слой и цвет были заданы явно, то нет запроса в функции ChangeTo0, но их легко поменять
(Defun c:ChangeTo0 ( / q_LayerName q_Color)
(Setq q_LayerName "0"
q_Color 256)
> ShaggyDoc
В данном случае слой "0" и byblock обладают одинаковыми свойствами
> ShaggyDoc
<<И во всех вариантах неверный подход - цвет примитивов блока надо делать не "послою", а "поблоку".>>
Не могли бы Вы обьяснить как тогда делать в блоке линии разной толщины при
использовании цветозависимой печати и как выключать часть линии в блоке
(деталировку) при использовании блока в мелком маштабе?
Все правы по-своему. Надо иметь выбор, как хочется починить блоки, чтобы они после ремонта стали по-слою, или по-блоку. А для этого надо четко уяснить для себя разницу между этими понятиями. Еще варианты http://dwg.ru/forum/viewtopic.php?t=225 … mp;start=0
Нравится Иннина дотошность, может, если будет время, исследуете и эти новые лиспы на предмет, какой что умеет и каким удобнее пользоваться, так как чем прога универсальней, тем в ней больше опций.
> Vova
Все лиспы рабочие (обрабатывают и вложенные блоки), но есть одно НО. Для блоков, вставленных с разными масштабами - не работает. При этом такими блоками могут считаться даже блоки, вставленные либо в предыдущих версиях када (проверено на 2005, файл 2002-го), либо блоки, имеющие атрибуты, либо блоки с измененными значениями масштабов по осям.
Как вариант:
За основу взят код от Эдуарда по указанной ссылке. Минимум добавлений.
Атрибуты с назначенными напрямую цветами не обрабатываются.
(defun _ed-blocks->norm ()
(defun _kpblc-ent-modify-autoregen (ent bit value
ext_regen / ent_list
old_dxf new_dxf layer_dxf70
)
(if (not
(and
(or
(= (cdr (assoc 0 (entget ent))) "STYLE")
(= (cdr (assoc 0 (entget ent))) "DIMSTYLE")
(= (cdr (assoc 0 (entget ent))) "LAYER")
) ;_ end of or
(= bit 100)
) ;_ end of and
) ;_ end of not
(progn
(setq ent_list (entget ent)
new_dxf (cons bit
(if (and (= bit 62) (= (type value) 'str))
(if (= (strcase value nil) "BYLAYER")
256
0
) ;_ end of if
value
) ;_ end of if
) ;_ end of cons
) ;_ end of setq
(if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
(progn
(entmod (if old_dxf
(subst new_dxf old_dxf ent_list)
(append ent_list (list new_dxf))
) ;_ end of if
) ;_ end of entmod
(if ent_regen
(entupd ent)
(redraw ent)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
ent
) ;_ end of defun
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vlax-for item (vla-get-layers *kpblc-activedoc*)
(if (equal (vla-get-lock item) :vlax-true)
(vla-put-lock item :vlax-false)
) ;_ end of if
) ;_ end of vlax-for
(vla-startundomark *kpblc-activedoc*)
(vlax-for item (vla-get-blocks *kpblc-activedoc*)
(if (not (wcmatch (vla-get-name item) "*Space*"))
(progn
(vlax-for item2 item
(vla-put-layer item2 "0")
(vla-put-linetype item2 "Byblock")
(vla-put-lineweight item2 -2)
(_kpblc-ent-modify-autoregen
(vlax-vla-object->ename item2)
62
"byblock"
nil
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of vlax-for
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
(vla-regen *kpblc-activedoc* acallviewports)
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defunДолжно вроде как сработать... Проходит по всему файлу, т.е. замечание по поводу "выбора" игнорировано (Vova, я пошел на это сознательно - имхо: если чистить, так уж все чистить).
> kpblc
> pavel
IMHO.
Правильный макрос:
^C^C(if (null c:ch-color) (load "ch-color"));ch-color
> Владимир Громов
Охотно верю. У меня-то подобные вопросы в принципе не встают - один загрузчик, который сразу всю папку с лиспами закидывает в активный документ, и потом вызов нужных функций. Поскольку проблема исчезла, и решение ее забылось напрочь.
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Перевод всех блоков в слой "0"
Форум работает на PunBB, при поддержке Informer Technologies, Inc
