[ilka_t]

Может кто сможнт лиспик написать
как в одном чертеже заменить часть блоков (выбрав их) на другой блок.

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

[{Smirnoff}]

http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21048Af

[Perezz!!]

Пожалуйста, создавайте темы соответственно разделам на форуме. Я понимаю, что это требует сложных умственных усилий, а польза возможно сомнительна, но в данном случае, ответ был очевиден - раздел Программирование.
Коллегу Смирнова, тоже прошу переносить такие темы.

[X-DeViL]

Ой... а что у нас новый модер? или это фантомас разбушевался?

[{Smirnoff}]

>Perezz!!

Ok. В запарке даже не обратил внимание где она была. Если тема в "моих" разделах то конечно буду перекидывать. В отстальных правов на телепортацию нету. Так что не обезсудь.

>X-Devil

Истина где то рядом...

[ilka_t]

Спасибо {Smirnoff} за помощь, пойду пробывать

to Perezz!! извини, ошибся с разделом, буду вниметельней

[Лентяй]

{Smirnoff}: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21048Af

Программка хороша, однако страдает тем же недостатком, что и экспрессовская, а именно - заменяющий объект (в данном случае - блок) долежен быть в базе данных файла перед запуском процедуры. Потому позволтли сеье проделать следующие изменения:

Код:

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

(defun *ERROR* (msg / objLay olaySt actDoc)
  (if olaySt (progn (vla-put-Lock objLay olaySt) (vla-EndUndoMark actDoc)) (princ))
); end of *ERROR*
;
(defun c:frto (/ ACTDOC COPOBJ ERRCOUNT EXTLST EXTSET BLKCOL BNAME PROP OBJLAY OKCOUNT OLAYST TOCEN VLAOBJ *ERROR*)
  (vl-load-com)
  (setq actDoc (vla-get-ActiveDocument (vlax-get-Acad-object))
        blkCol (vla-get-blocks actDoc))
  (if (not (setq extSet (ssget "_I")))
    (progn (princ "\n+++ Select distination objects and press Enter <- ")
      (setq extSet (ssget))));if
  (if (not extSet) (princ "\nDistination objects isn't selected!"));if
  (initget "Enter Select")
  (setq kword (getkword "\n[Enter/Select] source object: ? <Select>"))
  (if (null kword) (setq kw "Select"))
  (setq vlaObj (if (= kw "Select") (vlax-ename->vla-object (car (entsel)))
                 (progn (setq bname (getstring T "\nEnter New Block's Name: ? "))
                   (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list blkCol bname)))
                     (vla-delete (vla-insertBlock (vla-get-ModelSpace actdoc) (vlax-3d-point '(0.0 0.0 0.0))
                                   (getfiled "Select Source File" "" "dwg" 8) 1 1 1 0 "X")));if
                   (vla-item blkCol bname))));setq
  (if vlaObj 
    (progn (setq extLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex extSet))))
                 objLay (vla-Item (vla-get-Layers actDoc) (vla-get-Layer vlaObj))
                 olaySt (vla-get-Lock objLay) errCount 0 okCount 0);setq
      (vla-StartUndoMark actDoc)
      (foreach obj extLst
        (setq toCen (vla-get-InsertionPoint obj)
              prop (mapcar '(lambda (x) vlax-get-property obj (list x))
                         '(Layer XScaleFactor YScaleFactor ZScaleFactor Rotation))
              owner (vla-ObjectIDToObject actDoc (vla-get-objectID obj)));setq
        (if (/= :vlax-true (vla-get-Lock scLay))
          (progn (vla-put-Lock objLay :vlax-false)
            (setq copObj (vla-insertblock owner toCen bname 1 1 1 0))
            (apply '(lambda (x) (vlax-put-property copObj x)) prop)
            (vla-put-Lock objLay olaySt)
            (vla-Delete obj)
            (setq okCount (1+ okCount)));progn
          (setq errCount (1+ errCount)));if
      );foreach
      (princ (strcat "\n" (itoa okCount) " were changed. "
               (if (/= 0 errCount)
                 (strcat (itoa errCount) " were on locked layer! ") "")));princ
      (vla-EndUndoMark actDoc)
    );progn
    (princ "\nSource object isn't selected! ")
  );if
  (princ)
);end

Код не проверял.

[boban]

Код не работает.!!!!???
Можно ли в программе задать имя файла, на который нужно поменять?

[Лентяй]

boban:Код не работает.!!!!???

Ну, и подлец он после этого! Ничего, я им через пару часов займусь!

Можно ли в программе задать имя файла, на который нужно поменять?

Можно. У меня предучмотрена соотв. опция. Потерпите немного - отрихтую.

[Vova]

Экспрессовская команда Blockreplace, по-видимому, предназначена для того, чтобы блоку с атрибутами поменять сам блок, а старые атрибуты переходят как-бы под новую оболочку. Таким образом, поменять блок с атрибутами на другой блок с атрибутами по-простому не получается. Вот-бы сделать альтернативу Blockreplace чтобы блоки менялись с потрохами. По-умолчанию новый блок должен встать на место старого своей базовой точкой, а по желанию, если это возможно, базовой точкой нового блока в указанную точку старого. И все должно заменятся либо глобально, либо только в указанных местах, one by one или в указанной рамкой области

[{Smirnoff}]

>Лентяй

Брателло, зачем ты в моей "покалеченной" функции вынес локальный *ERROR* из тела основной функции?! Он ведь теперь глобальный и будет срабатывать на ошибки других прог.

Программка хороша, однако страдает тем же недостатком, что и экспрессовская, а именно - заменяющий объект (в данном случае - блок) долежен быть в базе данных файла перед запуском процедуры.

Честно говоря нифига не понял... Ну естественно должен быть, а как иначе?

[Лентяй]

Теперь работает! Выставляю на всеобщее осмеяние.

Код:

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

 (defun *ERROR* (msg / bklay bklyst adoc)
  (if bklay (progn (vla-put-Lock bklay bklyst) (vla-EndUndoMark adoc)) (princ))
); end of *ERROR*
;
(defun c:Bk2Bk (/ adoc atq nblk ass SSet blks bname kw prop lay owner errCount okCount bklay bklyst ins blk *error*)
  (vl-load-com)
  (setq adoc (vla-get-ActiveDocument (vlax-get-Acad-object))
        blks (vla-get-blocks adoc)
        atq (getvar "ATTREQ"))
  (setvar "ATTREQ" 0)
  (if (not (setq SSet (ssget "_I")))
    (progn (princ "\nSelect objects to change: ")
      (setq SSet (ssget))));if
  (if (not SSet) (alert "\nNo objects selected!"));if
  (initget "Enter Select")
  (setq kw (getkword "\n[Enter/Select] source object: ? <Select>"))
  (if (null kw) (setq kw "Select"))
  (setq blk (if (= kw "Select") (vlax-ename->vla-object (car (entsel)))
                 (progn (setq bname (getstring T "\nEnter New Block's Name: ? "))
                   (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list blks bname)))
                     (vla-delete (vla-insertBlock (vla-get-ModelSpace adoc) (vlax-3d-point '(0.0 0.0 0.0))
                                   (getfiled "Select Source File" "" "dwg" 8) 1 1 1 0)));if
                   (vla-item blks bname))));setq
  (if blk
    (progn (if (= kw "Select")
             (progn (setq bklay (vla-Item (vla-get-Layers adoc) (vla-get-Layer blk)))
               (setq bklyst (vla-get-Lock bklay))
               (vla-put-Lock bklay :vlax-false)));if
    (setq ass (vla-get-ActiveSelectionset adoc) errCount 0 okCount 0)
      (vla-StartUndoMark adoc)
      (vlax-for obj ass
        (setq ins (vla-get-InsertionPoint obj)
              lay (vla-Item (vla-get-Layers adoc) (vla-get-Layer obj))
              owner (vla-ObjectIDToObject adoc (vla-get-ownerID obj)))
              prop (mapcar '(lambda (x) (vlax-get-property obj x))
                         '(Layer XScaleFactor YScaleFactor ZScaleFactor Rotation)))
        (if (/= :vlax-true (vla-get-Lock lay))
          (progn (setq nblk (vla-insertblock owner ins bname 1 1 1 0.0))
            (mapcar '(lambda (x y) (vlax-put-property nblk x y))
                         '(Layer XScaleFactor YScaleFactor ZScaleFactor Rotation) prop)
            (vla-Delete obj)
            (setq okCount (1+ okCount)));progn
          (setq errCount (1+ errCount)));if
      );vlax-for
      (if (= kw "Select") (vla-put-Lock bklay bklyst))
      (princ (strcat "\n" (itoa okCount) " blocks were changed. "
               (if (/= 0 errCount)
                 (strcat (itoa errCount) " blocks were on locked layer! ") "")));princ
      (vla-EndUndoMark adoc)
    );progn
    (princ "\nSource object isn't selected! ")
  );if
  (setvar "ATTREQ" atq)
  (princ)
);end

{Smirnoff}: Брателло, зачем ты в моей "покалеченной" функции вынес локальный *ERROR* из тела основной функции?! Он ведь теперь глобальный и будет срабатывать на ошибки других прог.

Потому что мне так больще ндравицца.

Честно говоря нифига не понял... Ну естественно должен быть, а как иначе?

А вот, как у меня! Если нового блока еще нету, то мы его вставим извне, и будет стоять, как у молодого.

[Лентяй]

Vova: Вот-бы сделать альтернативу Blockreplace чтобы блоки менялись с потрохами

У меня именно так и сделано: поскольку ATTREQ = 0, значения атрибутов либо игнорируются, либо вставляются те, которые по умолчанию. Впрочем. можно сделать проверку на соответсвие TAGS (кстати, как это будет по русски - я уже забыл :? ) старого блока новому. В случае TRUE можно ввести присвоение атрибутам нового блока значений старого, а в случае FAULS - игнорировать. Но это уже завтра.

[{Smirnoff}]

>Лентяй

Потому что мне так больще ндравицца.

Если тебе так больше нравится то надо по крайней мере надо сохранять старое значение функции *ERROR* перед тем ка ты её переопределяешь, а при окончании программы и в теле самого обработчика ошибок его восстанавливать :!:

У тебя же теперь любая ошибка будет обрабатываться именно функцией *ERROR* которую ты вынес за пределы основной функции и геммороя необерёшся.

И вообще интересно как одна функция работает с локальными переменными другой функции :?:

А идея модернизации у тебя хорошая, правильная.

[Лентяй]

{Smirnoff}: У тебя же теперь любая ошибка будет обрабатываться именно функцией *ERROR* которую ты вынес за пределы основной функции и геммороя необерёшся.

Да пока бог миловал. и ничего такого не наблюдалось.

И вообще интересно как одна функция работает с локальными переменными другой функции.

Мне так кааца, что по заврешении программы, вызванной С:, все вспомагательные, даже если они находятся вне (defun C:), дезактивируются.[/b]

[{Smirnoff}]

>Лентяй

Да пока бог миловал. и ничего такого не наблюдалось.

Это потому что писал относительно безобидные *ERROR*. А вот я на эти грабли уже наступал. К примеру в теле *ERROR* есть удаление последнего созданного объекта. Так вот в таком варианте при любой ошибке функция будет удалять последний объект, отнюдь не относящийся к программе.

Сам подумай *ERROR* - встроенная функция AutoCAD отвечающая за восстановление среды и выдачу сообщений об ошибках. А мы её раз и меняем на свою которая чёрти что может делать.

Самый простой способ включать внутрь основной функции и писать *ERROR* в списке локальных переменных.

Либо в начале программы сохранять метку на старый *ERROR* в переменной, а потом восстанавливать.

Извиняй, расфилосовствовался... Но по такому поводу стоило сказать.

[Лентяй]

Спаибо за ценный совет, при случае как-нить попробую.

[Dym]

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

[fixo]

Сообщение от mitjaj а нельзя ли приделать к эти чтучкам чтоб блок заменял выбранный примитив или группу примитивов, вставляясь аккуратно в центре выбраннаго. навеяло "Вращение множества объектов вокруг локальнного центра". мне к примеру архи присылают на плане техоборудование отмеченное окружностью с заливкой

Пробуй:

Код:

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

(defun C:fbb (/ acsp adoc bname cent circ cset hatch_obj midp pt1 pt2 sset)
(vl-load-com)
(or adoc
    (setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
    )
(vla-endundomark
  adoc)  
(vla-startundomark
  adoc)  
(while (or (not (setq sset (ssget "+.:S" '((0 . "HATCH")))))
	   (not (setq hatch_obj (vlax-ename->vla-object (ssname sset 0))))))
(vla-highlight hatch_obj :vlax-true)  
(vla-getboundingbox hatch_obj 'pt1 'pt2)
(setq midp (vlax-3d-point (setq cent
	   (mapcar '* (mapcar '+
		(vlax-safearray->list pt1) 
                (vlax-safearray->list pt2))
		   '(0.5 0.5 0.5)))))

(vla-delete hatch_obj)
(vlax-release-object hatch_obj)
(if (setq cset (ssget "F" (list cent (getvar "vsmin"))'((0 . "CIRCLE"))))
(progn  
(setq circ (ssname cset 0))  
(vl-cmdf "erase" circ "")))
(setq bname (getstring "\n\t***\tУказать имя блока\t*** \n : "))  
(vla-Insertblock acsp  midp bname 1 1 1 0)  
(vla-endundomark
  adoc)
(vla-regen adoc acactiveviewport)
(princ)
)
(prompt "\n\t***\tВ командной строке ввести FBB  для выполнения\t*** \n : ")

[Dym]

2fatty:
слегка обкатал, а к примеру чтоб эта штучка объекты мгла выделять рамкой или поочерёдно в набор и вставляемый блок указывать на экране возможно? брошу пиво, сяду за учебники
p.s. мутно понимаю что сей код заточен под конкретное условие