Изменение масштаба типа линий в блоках.

shartal · 16.04.2014, 11:54

Существуют блоки, в которых разным объектам назначены разные масштабы типов линий. Штатными средствами изменить это без посещения блока невозможно. Нет ли какого-нибудь волшебного лиспа, который всем объектам блока назначит один масштаб типа линий?

ciril · 16.04.2014, 14:07

Всем блокам чертежа присваивает нужный масштаб типа линии:

Код:

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

 (defun c:задатьвеса  (/ x00 x01 x02 x03 x04 x05 x06 x07)
  (vl-load-com)
  (initget "Да Нет")
  (setq x00 (and (setq x00 (getkword
                             "\nОбрабатывать блоки, получившиеся после команды \"Вставить как блок\" (_pasteblock) [Да Нет]: <Да> "))
                 (eq "НЕТ" (strcase x00))))
  (initget 1)
  (setq x01 (getreal "\nВведите нужный масштаб типа линии: "))
  (setq x02 (list))
  (vlax-for e00  (setq x04 (vla-get-layers (setq x03 (vla-get-activedocument (vlax-get-acad-object)))))
    (progn (setq x05 (vla-get-freeze e00)
                 x06 (vla-get-lock e00))
           (and (or (eq :vlax-true x05) (eq :vlax-true x06))
                (progn (setq x02 (append x02 (list (list (vla-get-name e00) x05 x06))))
                       (vla-put-freeze e00 :vlax-false)
                       (vla-put-lock e00 :vlax-false)))))
  (princ (strcat "\nВ чертеже найдено описаний блоков: "
                 (itoa (setq x07 (vla-get-count (setq x03 (vla-get-blocks x03)))))))
  (repeat x07
    (princ
      (strcat "\nБлок \""
              (vla-get-name x05)
              "\" "
              (if (or (eq "*Paper_Space"
                          (setq x06 (substr (vla-get-name (setq x05 (vla-item x03 (setq x07 (1- x07))))) 1 12)))
                      (eq "*Model_Space" x06)
                      (and x00 (eq "A$C" (substr x06 1 3))))
                "не "
                (progn (repeat (setq x06 (vla-get-count x05))
                         (vla-put-linetypescale (vla-item x05 (setq x06 (1- x06))) x01))
                       ""))
              "обработан, осталось "
              (itoa x07))))
  (mapcar (function (lambda (e00)
                      (vla-put-freeze (setq x07 (vla-item x04 (car e00))) (cadr e00))
                      (vla-put-lock x07 (caddr e00))))
          x02)
  (princ))
(princ
  "\nМеняет масштаб типов линий примитивов во всех блоках чертежа на заданный.\nВызывается командой ЗАДАТЬВЕСА")

shartal · 16.04.2014, 14:52

После введения масштаба, такое сообщение: "В чертеже найдено описаний блоков: 34; ошибка: неверный тип аргумента:
VLA-OBJECT :vlax-false"

Boxa · 16.04.2014, 16:58

Не лисп, но все же...
Вот эта библиотека : http://experement.spb.ru/wiki/doku.php?id=purge_pp
Команда: BX_PURGE__BY_LAYER

Do$ · 16.04.2014, 17:58

Цитата:

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

Всем блокам чертежа присваивает нужный масштаб типа линии:

Есть подозрение, что и по внешним ссылкам лисп прогуляется.
С фантазией совсем плохо, раз такие имена у переменных?

Шутки шутками, но читать такой код очень сложно.

shartal · 17.04.2014, 11:10

Для Boxa, Из каких соображений требуется доступ в интернет? Его по определению не бывает у инженеров в любой мало мальски серьезной организации.
Кроме того команда BX_PURGE__BY_LAYER меняет массу свойств, которые трогать не надо. Речь идет только а масштабе типа линий.

Do$ · 17.04.2014, 11:25

Цитата:

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

Его по определению не бывает у инженеров в любой мало мальски серьезной организации.

К сожалению, распространенное заблуждение.

Boxa · 17.04.2014, 11:44

Цитата:

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

Для Boxa, Из каких соображений требуется доступ в интернет?

Из соображений о необходимости информирования пользователей о наличии обновлений.

Цитата:

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

Его по определению не бывает у инженеров в любой мало мальски серьезной организации.

Серьезно? Задания смежникам и субподрядчикам на флешках с почтовыми голубями посылают?

Цитата:

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

Кроме того команда BX_PURGE__BY_LAYER меняет массу свойств, которые трогать не надо. Речь идет только а масштабе типа линий.

"Последний раз редактировалось Boxa, вчера в 17:15. Причина: Удалить не дает. ошибся, не так понял что нужно. " я как бы намекнул...

shartal · 17.04.2014, 11:45

Из опыта скажу, если в системной безопасности образуются дыры, трафик немедленно вырастает до чудовищных размеров. Качаются фильмы, музыка и т.д. О безопасности я даже не говорю.
Сайты типа dwg.ru есественно открыты.
Как я понял, еще вариантов управления масштабом совсем нет?

ciril · 17.04.2014, 12:15

Код:

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

 (defun c:задатьвеса  (/ x00 x01 x02 x03 x04 x05 x06 x07)
  (vl-load-com)
  (initget "Да Нет")
  (setq x00 (and (setq x00 (getkword
                             "\nОбрабатывать блоки, получившиеся после команды \"Вставить как блок\" (_pasteblock) [Да Нет]: <Да> "))
                 (eq "Нет" (strcase x00))))
  (initget 1)
  (setq x01 (getreal "\nВведите нужный масштаб типа линии: "))
  (setq x02 (list))
  (vlax-for e00  (setq x04 (vla-get-layers (setq x03 (vla-get-activedocument (vlax-get-acad-object)))))
    (progn (setq x05 (vla-get-freeze e00)
                 x06 (vla-get-lock e00))
           (and (or (eq :vlax-true x05) (eq :vlax-true x06))
                (progn (setq x02 (append x02 (list (list (vla-get-name e00) x05 x06))))
                       (vl-catch-all-apply 'vla-put-freeze (list e00 :vlax-false))
                       (vla-put-lock e00 :vlax-false)))))
  (princ (strcat "\nВ чертеже найдено описаний  блоков: "
                 (itoa (setq x07 (vla-get-count (setq x03 (vla-get-blocks x03)))))))
  (repeat x07
    (princ (strcat "\nБлок \""
                   (vla-get-name (setq x05 (vla-item x03 (setq x07 (1- x07)))))
                   "\" "
                   (if (or (eq "*Paper_Space" (setq x06 (substr (vla-get-name x05) 1 12)))
                           (eq "*Model_Space" x06)
                           (and x00 (eq "A$C" (substr x06 1 3))))
                     "не "
                     (progn (repeat (setq x06 (vla-get-count x05))
                              (vla-put-linetypescale (vla-item x05 (setq x06 (1- x06))) x01))
                            ""))
                   "обработан, осталось  "
                   (itoa x07))))
  (mapcar (function
            (lambda (e00)
              (vl-catch-all-apply 'vla-put-freeze (list (setq x07 (vla-item x04 (car e00))) (cadr e00)))
              (vla-put-lock x07 (caddr e00))))
          x02)
  (princ))
(princ
  "\nМеняет масштаб типов линий в блоках на заданный.\nВызывается ЗАДАТЬВЕСА")

Do$, это от лени, чтобы в окне отслеживания всякий раз новые имена не вносить

Boxa · 17.04.2014, 12:32

ciril
переменная x01 может быть равна нулю или отрицательной? В лиспе не очень разбираюсь...

Из спортивного интереса:

Код:

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

    <CommandMethod("bx_purge__LinetypeScale")> _
    Public Sub bx_purge__LinetypeScale()

        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database

        Dim scaleOpt As PromptDoubleOptions = New PromptDoubleOptions(ControlChars.CrLf & "Назничить масштаб линии равный: ")
        scaleOpt.AllowZero = False
        scaleOpt.AllowNegative = False
        scaleOpt.AllowNone = False
        Dim scaleRes As PromptDoubleResult = acDoc.Editor.GetDouble(scaleOpt)
        If scaleRes.Status <> PromptStatus.OK Then
            Exit Sub
        End If

        Dim scale As Double = scaleRes.Value
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            Dim acTypValAr(0) As TypedValue
            acTypValAr.SetValue(New TypedValue(DxfCode.Start, "INSERT"), 0)
            Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
            Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection(acSelFtr)
            If acSSPrompt.Status <> PromptStatus.OK Then
                Exit Sub
            End If
            Dim acSSet As SelectionSet = acSSPrompt.Value
            For Each acSSObj As SelectedObject In acSSet
                If Not IsDBNull(acSSObj) Then
                    Dim acEnt As Entity = CType(acTrans.GetObject(acSSObj.ObjectId, _
                                                OpenMode.ForRead), Entity)
                    If Not IsDBNull(acEnt) Then
                        If TypeOf acEnt Is BlockReference Then
                            Dim acBlock As BlockReference = CType(acEnt, BlockReference)
                            Dim blr As BlockTableRecord = CType(acTrans.GetObject(acBlock.DynamicBlockTableRecord, _
                                                                   OpenMode.ForRead), BlockTableRecord)

                            Dim blr_nam As BlockTableRecord = CType(acTrans.GetObject(blr.ObjectId, _
                                                  OpenMode.ForRead), BlockTableRecord)
                            For Each acObjId As ObjectId In blr_nam
                                Dim acEnt_inBlock As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead)
                                Dim layerEnt As LayerTableRecord = acTrans.GetObject(acEnt_inBlock.LayerId, OpenMode.ForRead)
                                If layerEnt.IsLocked = False Then
                                    acEnt_inBlock.UpgradeOpen()
                                    acEnt_inBlock.LinetypeScale = scale
                                    acEnt_inBlock.DowngradeOpen()
                                End If
                            Next
                        End If
                    End If
                End If
            Next
            acTrans.Commit()
        End Using
    End Sub

ciril · 17.04.2014, 13:13

Boxa, спасибо, не может быть ни отрицательно, ни нулевой. В кода в строке 07 (initget 1) нужно заменить на (initget 7)

shartal · 17.04.2014, 18:35

Для Boxa. За информацию об обновлении конечно спасибо, но нельзя ли убрать эту необходимость. У вас на сайте есть кое что полезное, но увы не применимое в наших условиях.

Boxa · 18.04.2014, 08:19

Цитата:

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

За информацию об обновлении конечно спасибо, но нельзя ли убрать эту необходимость. У вас на сайте есть кое что полезное, но увы не применимое в наших условиях.

Позволю себе процитировать фрагмент главной страницы:

Цитата:

Если Вас заинтересовали эти программы, но есть желание что-то переделать или написать «под себя», свяжитесь со мной, договоримся.

16.04.2014, 11:54		#1
Изменение масштаба типа линий в блоках. shartal Регистрация: 12.08.2009 Сообщений: 464 Существуют блоки, в которых разным объектам назначены разные масштабы типов линий. Штатными средствами изменить это без посещения блока невозможно. Нет ли какого-нибудь волшебного лиспа, который всем объектам блока назначит один масштаб типа линий?
Просмотров: 4119

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Создание нового типа линий	Apelsinov	AutoCAD	915	08.07.2022 12:36
Автоподбор масштаба типа линии	kp+	Программирование	4	27.12.2007 08:52
Создание типа линий для обозначения кабелей связи	Geon	AutoCAD	1	04.11.2007 10:02
Избитая тема МАСШТАБА ТИПА ЛИНИЙ	Asset	AutoCAD	21	15.08.2007 12:32
ГОСТ на ванты и оттяжки ???	зщцук?	Поиск литературы, чертежей, моделей и прочих материалов	1	17.05.2005 06:53