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

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

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

Ответ
Поиск в этой теме
Непрочитано 16.04.2014, 11:54 #1
Изменение масштаба типа линий в блоках.
shartal
 
Регистрация: 12.08.2009
Сообщений: 445

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

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 285


Всем блокам чертежа присваивает нужный масштаб типа линии:
Код:
[Выделить все]
 (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Вызывается командой ЗАДАТЬВЕСА")
ciril вне форума  
 
Автор темы   Непрочитано 16.04.2014, 14:52
#3
shartal


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


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

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,583


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

Последний раз редактировалось Boxa, 16.04.2014 в 17:15. Причина: Удалить не дает. ошибся, не так понял что нужно.
Boxa на форуме  
 
Непрочитано 16.04.2014, 17:58
#5
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от ciril Посмотреть сообщение
Всем блокам чертежа присваивает нужный масштаб типа линии:
Есть подозрение, что и по внешним ссылкам лисп прогуляется.
С фантазией совсем плохо, раз такие имена у переменных? Шутки шутками, но читать такой код очень сложно.
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
 
Автор темы   Непрочитано 17.04.2014, 11:10
#6
shartal


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


Для Boxa, Из каких соображений требуется доступ в интернет? Его по определению не бывает у инженеров в любой мало мальски серьезной организации.
Кроме того команда BX_PURGE__BY_LAYER меняет массу свойств, которые трогать не надо. Речь идет только а масштабе типа линий.
shartal вне форума  
 
Непрочитано 17.04.2014, 11:25
#7
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от shartal Посмотреть сообщение
Его по определению не бывает у инженеров в любой мало мальски серьезной организации.
К сожалению, распространенное заблуждение.
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
 
Непрочитано 17.04.2014, 11:44
#8
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,583


Цитата:
Сообщение от shartal Посмотреть сообщение
Для Boxa, Из каких соображений требуется доступ в интернет?
Из соображений о необходимости информирования пользователей о наличии обновлений.
Цитата:
Сообщение от shartal Посмотреть сообщение
Его по определению не бывает у инженеров в любой мало мальски серьезной организации.
Серьезно? Задания смежникам и субподрядчикам на флешках с почтовыми голубями посылают?
Цитата:
Сообщение от shartal Посмотреть сообщение
Кроме того команда BX_PURGE__BY_LAYER меняет массу свойств, которые трогать не надо. Речь идет только а масштабе типа линий.
"Последний раз редактировалось Boxa, вчера в 17:15. Причина: Удалить не дает. ошибся, не так понял что нужно. " я как бы намекнул...
Boxa на форуме  
 
Автор темы   Непрочитано 17.04.2014, 11:45
#9
shartal


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


Из опыта скажу, если в системной безопасности образуются дыры, трафик немедленно вырастает до чудовищных размеров. Качаются фильмы, музыка и т.д. О безопасности я даже не говорю.
Сайты типа dwg.ru есественно открыты.
Как я понял, еще вариантов управления масштабом совсем нет?
shartal вне форума  
 
Непрочитано 17.04.2014, 12:15
1 | #10
ciril

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 285


Код:
[Выделить все]
 (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$, это от лени, чтобы в окне отслеживания всякий раз новые имена не вносить
ciril вне форума  
 
Непрочитано 17.04.2014, 12:32
#11
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,583


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
Boxa на форуме  
 
Непрочитано 17.04.2014, 13:13
#12
ciril

САПР
 
Регистрация: 29.09.2011
СПб
Сообщений: 285


Boxa, спасибо, не может быть ни отрицательно, ни нулевой. В кода в строке 07 (initget 1) нужно заменить на (initget 7)
ciril вне форума  
 
Автор темы   Непрочитано 17.04.2014, 18:35
#13
shartal


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


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

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,583


Цитата:
Сообщение от shartal Посмотреть сообщение
За информацию об обновлении конечно спасибо, но нельзя ли убрать эту необходимость. У вас на сайте есть кое что полезное, но увы не применимое в наших условиях.
Позволю себе процитировать фрагмент главной страницы:
Цитата:
Если Вас заинтересовали эти программы, но есть желание что-то переделать или написать «под себя», свяжитесь со мной, договоримся.
Boxa на форуме  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Изменение масштаба типа линий в блоках.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание нового типа линий 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