Добро пожаловать!

Войдите или зарегистрируйтесь сейчас!

Войти

Расстановка блоков по точкам

Тема в разделе "Autocad", создана пользователем Бурдей, 25 ноя 2019.

  1. Бурдей

    Регистрация:
    3 сен 2013
    Сообщения:
    12
    Симпатии:
    0
    Приветствую! Есть ли какой лисп для распределения блоков по определенным точкам? Например блок «имя» проставить по всем точкам слоя «Точки по осям».
     
    #1
  2. Neznayka

    Форумчанин

    Регистрация:
    8 дек 2007
    Сообщения:
    466
    Симпатии:
    320
    Адрес:
    Brest
    Возможно вам пригодится этот лисп. Выбираете точки, потом шаблон, и выбранные точки заменяется на шаблон
    zamena.lsp (раскрыть)

    (defun c:frto(/ ACTDOC COPOBJ ERRCOUNT EXTLST
    EXTSET FROMCEN LAYCOL MAXPT CURLAY
    MINPT OBJLAY OKCOUNT OLAYST
    SCLAY TOCEN TOOBJ VLAOBJ *ERROR* ASK)
    (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))
    (+(caddr blPt)(/(-(caddr trPt)(caddr blPt))2)) ;_<<< Заменили
    )))); end of GetBoundingCenter
    (setq extSet(ssget "_I"))
    (while (not (setq toObj(entsel "\n+++ Select source object -> ")))
    (princ "\nSource objects isn't selected!"))
    (if(not extSet)
    (progn
    (princ "\n+++ Select destination objects and press Enter <- ")
    (setq extSet(ssget "_:L")))); end if
    (if(not extSet)(princ "\nDestination objects isn't selected!")); end if
    (if (and extSet toObj)
    (progn
    (initget "Yes No")
    (setq ask (getkword "\nRemove source object [Yes/No] <No>:"))
    (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)
    (_kpblc-ent-properties-copy obj copObj)
    (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! ") "")))
    (if (= ask "Yes")
    (if(/= :vlax-true(vla-get-Lock objLay))
    (vla-Delete vlaObj)
    (princ "\nSource object on locked layer! ")))
    (vla-EndUndoMark actDoc)); end progn
    (princ "\nSource object isn't selected! ")
    ); end if
    (princ)); end of c:frto

    ;|=============================================================================
    * Функция копирования настроек примитивов
    * Параметры вызова:
    * source примитив-источник (vla)
    * dest примитив-получатель (vla)
    * Выполняется копирование всех настроек (кроме точек, координат и т.п.), если
    * это возможно. Копирование радиусов дуг и окружностей не выполняется.
    * Контроль и преобразование параметров не выполняется.
    * Примеры вызова:
    (_kpblc-ent-properties-copy (vlax-ename->vla-object (car (entsel))) (vlax-ename->vla-object (car (entsel))))
    * URL http://www.arcada.com.ua/forum/viewtopic.php?t=504&start=15
    =============================================================================|;
    (defun _kpblc-ent-properties-copy (source dest)
    (foreach prop '("Angle" "Layer" "Linetype" "LinetypeScale" "Lineweight"
    "Normal" "PlotStyleName" "Thickness" "Color" "Visible"
    "Closed" ;|"ConstantWidth" ; не копируется|; "Elevation" "LinetypeGeneration"
    "LinetypeScale" ;|"StartAngle" "EndAngle" ; не копируются|; "Alignment"
    "Backward" "Height" "ObliqueAngle" "Rotation" "ScaleFactor" "StyleName"
    "TextGenerationFlag" "TextHeight" "UpsideDown" "AttachmentPoint" "BackgroundFill"
    "DrawingDirection" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle" "Width"
    "XScaleFactor" "YScaleFactor" "ZScaleFactor" ;| Viewport|; "ArcSmoothness" "CustomScale"
    "Direction" "DisplayLocked" "GridOn" "LensLength" "ModelView" "ShadePlot" "SheetView"
    "SnapBasePoint" "SnapOn" "SnapRotationAngle" "StandardScale" "Target" "TwistAngle"
    "UCSIconAtOrigin" "UCSIconOn" "UCSPerViewport" "ViewportOn")
    (if (and (vlax-property-available-p source prop)(vlax-property-available-p dest prop t))
    (_kpblc-error-catch
    '(lambda ()(vlax-put-property dest prop (vlax-get-property source prop))) nil)))) ;_ end of defun
    ;|=============================================================================
    * Оболочка отлова ошибок.
    * Параметры вызова:
    * protected-function — "защищаемая" функция
    * on-error-function — функция, выполняемая в случае ошибки
    * URL http://www.arcada.com.ua/forum/viewtopic.php?t=504&start=15
    =============================================================================|;
    (defun _kpblc-error-catch
    (protected-function on-error-function / catch_error_result)
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result) on-error-function)
    (apply on-error-function
    (list (vl-catch-all-error-message catch_error_result)))
    catch_error_result)) ;_ end of defun
     
    #2
  3. ivsem

    Форумчанин

    Регистрация:
    26 мар 2009
    Сообщения:
    2.475
    Симпатии:
    1.051
    Адрес:
    Киев
    Пробуй. Запуск программы- набрать число 11 и нажать Enter.
     

    Вложения:

    #3
    Последнее редактирование: 26 ноя 2019
    Бурдей нравится это.
  4. Бурдей

    Регистрация:
    3 сен 2013
    Сообщения:
    12
    Симпатии:
    0
    Класс! Спасибо!)
     
    #4
  5. Negaday

    Форумчанин

    Регистрация:
    12 янв 2018
    Сообщения:
    703
    Симпатии:
    504
    а есть ли такой лисп,который расставит блоки не по точкам,а скажем по вершинам полилинии?
    p.s.извините.уже нашел
     
    #5
    Последнее редактирование: 2 дек 2019

Поделиться этой страницей

  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie.
    Скрыть объявление