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

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

Частичная замена блока

Ответ
Поиск в этой теме
Непрочитано 06.04.2020, 08:51 #1
Частичная замена блока
танбраун
 
Регистрация: 28.02.2019
Сообщений: 53

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

Код:
[Выделить все]
 (defun c:ЗАМЕНА(/ ACTDOC COPOBJ ERRCOUNT EXTLST
        EXTSET FROMCEN LAYCOL MAXPT CURLAY
        MINPT OBJLAY OKCOUNT OLAYST
        SCLAY TOCEN TOOBJ VLAOBJ *ERROR*)
  (vl-load-com)
  (defun *ERROR*(msg)
    (if olaySt
      (vla-put-Lock objLay olaySt)
      ); end if
    (vla-EndUndoMark actDoc)
    (princ)
    ); end of *ERROR*
  (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
  (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
      (setq blPt(vlax-safearray->list minPt)
       trPt(vlax-safearray->list maxPt)
       cnPt(vlax-3D-point
        (list
             (+(car blPt)(/(-(car trPt)(car blPt))2))
             (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
          0.0
            ); end list
      ); end vlax-3D-point
     ); end setq
  ); end of GetBoundingCenter
  (if(not(setq extSet(ssget "_I")))
    (progn
      (princ "\nВыберите объекты, которые нужно заменить ")
      (setq extSet(ssget))
      ); end progn
    ); end if
  (if(not extSet)
    (princ "\nDistination objects isn't selected!")
    ); end if
  (if
    (and
    extSet
    (setq toObj(entsel "\nУкажите объект-образец "))
    ); and and
    (progn
      (setq actDoc
        (vla-get-ActiveDocument
          (vlax-get-Acad-object))
       layCol
        (vla-get-Layers actDoc)
       extLst
        (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex extSet))))
       vlaObj(vlax-ename->vla-object(car toObj))
       objLay(vla-Item layCol
             (vla-get-Layer vlaObj))
       olaySt(vla-get-Lock objLay)
       fromCen(GetBoundingCenter vlaObj)
       errCount 0
       okCount 0
       ); end setq
      (vla-StartUndoMark actDoc)
      (foreach obj extLst
   (setq toCen(GetBoundingCenter obj)
         scLay(vla-Item layCol
              (vla-get-Layer obj))
              );end setq
   (if(/= :vlax-true(vla-get-Lock scLay))
     (progn
     (setq curLay(vla-get-Layer obj))
     (vla-put-Lock objLay :vlax-false)
     (setq copObj(vla-copy vlaObj))
     (vla-Move copObj fromCen toCen)
     (vla-put-Layer copObj curLay)
     (vla-put-Lock objLay olaySt)
     (vla-Delete obj)
     (setq okCount(1+ okCount))
     ); end progn
     (setq errCount(1+ errCount))
     ); end if
   ); end foreach
      (princ
   (strcat "\n" (itoa okCount) " were changed. "
      (if(/= 0 errCount)
        (strcat (itoa errCount) " were on locked layer! ")
        ""
        ); end if
      ); end strcat
   ); end princ
      (vla-EndUndoMark actDoc)
      ); end progn
    (princ "\nSource object isn't selected! ")
    ); end if
  (princ)
  ); end of c:ЗАМЕНА

Вложения
Тип файла: dwg
DWG 2013
Чертеж1.dwg (207.4 Кб, 6 просмотров)


Последний раз редактировалось Кулик Алексей aka kpblc, 06.04.2020 в 09:43.
Просмотров: 1379
 
Автор темы   Непрочитано 13.04.2020, 08:15
#2
танбраун


 
Регистрация: 28.02.2019
Сообщений: 53


А если упростить задачу и сделать только вариант №1: заменить все кроме геометрии блока (штриховку и атрибуты тоже менять).
танбраун вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Частичная замена блока

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Замена одного блока другим Victor Готовые программы 37 18.08.2016 13:02
Замена одного блока на другой средствами VBA НовичOK Программирование 7 25.11.2010 16:48
Замена цвета блока или блока на блок maximator Программирование 25 24.09.2009 16:02
Замена блока Axe-d AutoCAD 4 06.08.2009 14:51
Замена простого блока на динамический Vova Программирование 5 11.05.2009 22:02