Тема: Замена выделенных мультилиний на мультилинии другого типа.

В 2005 существует один глюк, касающийся штриховки мультилиний с дополнительными внутренними линиями - на всех изгибах штриховка ложится как бог на душу положит! ;). Закономерность не ясна...
Помогите сделать лисп, проводящий поверх каждой, из существующего выделенного рамкой или по очереди, набора мультилиний, новую мультилинию заданного типа, и по запросу удаляющую старые линии.
Алгоритм предлагаю такой:
1.Слой на котором создаются новые мультилинии - текущий.
2.Тип новых линий - выбранный до этого по умолчанию.
3.Justification новых линий - выбранный по умолчанию.
4.Выбираем набор линиий на любых слоях, поверх которых нужно нанести новые либо заменить.
5.Лисп по координатам вершин сегментов существующих линий наносит новые с параметрами в п.п. 1,2,3.
6.Предлагает удалить старый набор линий Y/N (N).
7.Удаляем если надо!
Позволит легко:
- рисовать штукатурные стенки поверх кирпичных, наоборот и другие подобные замены!
- заменять линии с неправильными параметрами.
- делает линии, подходяшие для штриховки!
Особенно удобно когда линий несколько этажей по 10 000 м2 :)!

Re: Замена выделенных мультилиний на мультилинии другого типа.

Если это невозможно - скажите прямо! :)
Можно ли тогда каким то образом поменять параметры уже имеющихся мультилиний?
Например удалить/добавить элементы или их свойства. Чтобы изменения коснулись всех мультилиний данного файла.

Re: Замена выделенных мультилиний на мультилинии другого типа.

> iv
Вот я прямо и скажу. IMHO - невозможно. Еще раз IMHO - ни к чему. Если кто не согласен - так прямо и скажите.

Re: Замена выделенных мультилиний на мультилинии другого типа.

> Владимир Громов
Невозможно 1  или 2?
Какую опцию включить чтобы мультилиния из 3-х элементов корректно штриховалась на поворотах?

Re: Замена выделенных мультилиний на мультилинии другого типа.

> iv
Я за себя скажу. От использования мультилинии отказался лет 10 назад. Бесперспективный объект.

Re: Замена выделенных мультилиний на мультилинии другого типа.

> Владимир Громов
Полностью согласен! Сам их только с год использую!
Однако стеночки на 2d планировочках им лучше всего рисовать! :) И менять! :)
Кирпич - 120   Со штукатуркой - 170, а там хоть трава не расти!
   Все мы лентяи и любим помучиться а потом за 5 минут долететь!

Re: Замена выделенных мультилиний на мультилинии другого типа.

Пошарил еще раз по форуму и за пределами! Тема по "редактированию" мультилинии всплывала кучу раз!
Однако по какой то причине готовых решений нет (или не нашел). :(
Что непонятно, командой типа:
(vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object (car (entsel))))))
координаты вершин имеющейся линии выводятся корректно!
Т.е. по ним легко можно нарисовать новую с текущими свойствами, а при некотором замудрении и со специально указанными.
Но по чему то темы быстро умирают... :(
Конечно понимаю, народ ML пользуется мало!, однако в некоторых случаях это решение более удобно, особенно на планировках, когда  каждую кривую стену двигаешь по пять раз в день!
Удобство параллельных PL в этом случае быстро испаряется. Уж поверьте! Или не знаю как нужно с ними работать!
Конечно, когда у меня будет Core2Duo c 1 гигом памяти, попробую сразу начать новый проект на ADT! :)
Но что делать с текущими?

Re: Замена выделенных мультилиний на мультилинии другого типа.

Для штриховки мультилиний использовал следующий лисп

(defun massoc (key alist)
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))
(defun lst-lst-key (key lst / buf ret)
  (foreach x lst
    (if (= (car x) key)(setq ret (append ret (list buf)) buf nil))
    (setq buf (append buf (list x))))
  (setq ret (append ret (list buf))))
(defun makeUniqueMlineStyleName ( oldStile / stlist stname i)
  (setq stList (massoc 3 (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))
  (if (not (member (strcase oldStile) *MLINESTYLE*))
    (progn
      (setq i 0)
      (while (member (setq stname (strcat oldStile "-" (itoa (setq i (1+ i))))) stlist)))
    (setq stname nil)) stname)
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn (setq ls nil)
      (repeat (/ (length lst) num)
  (repeat num (setq ls
        (cons (car lst) ls)
        lst (cdr lst)))
  (setq ret (append ret (list (reverse ls)))
        ls nil)))) ret)
(defun mknewstyle ( en / stname elist opts ret _ml Mmax Mmin opts nstname new_ml entmkx)
(setq stname (strcase(cdr(assoc 2 (entget en)))))
(if (progn (setq elist nil opts nil)
      (foreach x (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
        (if (and (= (car x) 3)(= (strcase (cdr x))  stname))
          (setq opts t))
        (if opts (setq elist (append elist (list x))))
        )
      elist )
  (progn
    (setq elist (entget(cdr(assoc 350 elist))))
    (setq _ml (lst-lst-key 49 elist))
    (foreach x (cdr _ml)
      (if (or (null Mmax)
              (< (cdr(assoc 49 Mmax))(cdr(assoc 49 x)))
              )
               (setq Mmax x))
      (if (or (null Mmin)
              (> (cdr(assoc 49 Mmin))(cdr(assoc 49 x))))
                 (setq Mmin x))
      )
  (setq opts  (list
            '(0 . "MLINESTYLE")
            '(102 . "{ACAD_REACTORS")
            (cons 330 (cdr(assoc -1 (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))))
            '(102 . "}")
            '(100 . "AcDbMlineStyle")
            '(70 . 0)
            ;; End Cap Flag Values: 0 - No caps; 16 - Cap first end
            ;; 256 - Cap last end; 272 - Cap each end;
            ;; See also AutoCAD Customization Guide, Appendix C -
            ;; "ACAD_MLINESTYLE Group Codes" Table for other values
            ;;'(62 . 0) ; Fill Color, if flag 70 has 1 set
            (cons 51 (/ PI 2)) ; Start Angle
            (cons 52 (/ PI 2)) ; End Angle
        ))
    (if (setq nstname (makeUniqueMlineStyleName (cdr(assoc 2 (car _ml)))))
      (progn
        (setq *MLINESTYLE* (append *MLINESTYLE* (list nstname)))
        (setq new_ml
               (append opts
                 (list (cons 2 nstname))
                 (list (cons 71 2))
                  Mmax
                  Mmin))
        (setq entmkx (entmakex new_ml))
        (entmod (append (dictsearch (namedobjdict) "ACAD_MLINESTYLE")(list (cons 3 nstname)(cons 350 entmkx))))
        (setq ret nstname)
       );_progn
     )
    )
  )
  ret
  )
(defun C:MLD ( / sset lst nst ed crs clos _J osm)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
      (if (setq nst (mknewstyle e1))
        (progn
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_ST" nst)
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
          )
      )
    )
  )
  )
  (princ)
  )

Создает новый стиль мультилинии на основе выбранной, состоящий из 2 крайних линий и обрисовывает текущую млининию этим стилем.

Re: Замена выделенных мультилиний на мультилинии другого типа.

Найден баг, не задавался масштаб млинии

(defun C:MLD ( / sset lst nst ed crs clos _J osm)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
      (if (setq nst (mknewstyle e1))
        (progn
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_ST" nst "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
          )
      )
    )
  )
  )
  (princ)
  )

Остальные ф-ции см. выше

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Функционирует! Основная идея замены ML выполняется.
Привязывается к zero/top правильно.
Однако есть ряд вопросов и предложений:
1.На планировке нуждаются в "замене" от 70 до 200 МЛ. Для каждой создается новый тип. В результате их получается ... :)
Даже не знаю, хорошо это или плохо (для последующего счета в Excel явно плохо :)).
Все таки считаю, что целесообразнее заменять на существующий у пользователя тип, и если он ошибся с его толщиной/ориентацией пусть делает UNDO и подставляет подходящий тип сам, т.к. везде соломки не подстелишь!
2. Так-же это полезно если нужна ML другой толщины, что встречается - напр кирпич-штукатурка-звукоизоляция-ГКЛ! Поэтому, по моему должны использоваться только координаты существующей.
3. Имеет смысл предложить стирание "исходных" (по умолчанию "NO").
Напрасно стертые и вовремя не восстановленные можно извлечь из "из того же материала"! :)

Re: Замена выделенных мультилиний на мультилинии другого типа.

Задача того лиспа была восстановить корректно крайние линии стиля для штриховки. Я давно бросил MLINE, но смутно помню, что при попытке обрисовки из лиспа не всегда корректно отрабатывала _Close. Вот набросал. Собрал все в кучу

(defun massoc (key alist)
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))
(defun lst-lst-key (key lst / buf ret)
  (foreach x lst
    (if (= (car x) key)(setq ret (append ret (list buf)) buf nil))
    (setq buf (append buf (list x))))
  (setq ret (append ret (list buf))))
(defun makeUniqueMlineStyleName ( oldStile / stlist stname i)
  (setq stList (massoc 3 (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))
  (if (not (member (strcase oldStile) *MLINESTYLE*))
    (progn
      (setq i 0)
      (while (member (setq stname (strcat oldStile "-" (itoa (setq i (1+ i))))) stlist)))
    (setq stname nil)) stname)
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn (setq ls nil)
      (repeat (/ (length lst) num)
  (repeat num (setq ls
        (cons (car lst) ls)
        lst (cdr lst)))
  (setq ret (append ret (list (reverse ls)))
        ls nil)))) ret)
(defun mknewstyle ( en / stname elist opts ret _ml Mmax Mmin opts nstname new_ml entmkx)
(setq stname (strcase(cdr(assoc 2 (entget en)))))
(if (progn (setq elist nil opts nil)
      (foreach x (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
        (if (and (= (car x) 3)(= (strcase (cdr x))  stname))
          (setq opts t))
        (if opts (setq elist (append elist (list x))))
        )
      elist )
  (progn
    (setq elist (entget(cdr(assoc 350 elist))))
    (setq _ml (lst-lst-key 49 elist))
    (foreach x (cdr _ml)
      (if (or (null Mmax)
              (< (cdr(assoc 49 Mmax))(cdr(assoc 49 x)))
              )
               (setq Mmax x))
      (if (or (null Mmin)
              (> (cdr(assoc 49 Mmin))(cdr(assoc 49 x))))
                 (setq Mmin x))
      )
  (setq opts  (list
            '(0 . "MLINESTYLE")
            '(102 . "{ACAD_REACTORS")
            (cons 330 (cdr(assoc -1 (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))))
            '(102 . "}")
            '(100 . "AcDbMlineStyle")
            '(70 . 0)
            ;; End Cap Flag Values: 0 - No caps; 16 - Cap first end
            ;; 256 - Cap last end; 272 - Cap each end;
            ;; See also AutoCAD Customization Guide, Appendix C -
            ;; "ACAD_MLINESTYLE Group Codes" Table for other values
            ;;'(62 . 0) ; Fill Color, if flag 70 has 1 set
            (cons 51 (/ PI 2)) ; Start Angle
            (cons 52 (/ PI 2)) ; End Angle
        ))
    (if (setq nstname (makeUniqueMlineStyleName (cdr(assoc 2 (car _ml)))))
      (progn
        (setq *MLINESTYLE* (append *MLINESTYLE* (list nstname)))
        (setq new_ml
               (append opts
                 (list (cons 2 nstname))
                 (list (cons 71 2))
                  Mmax
                  Mmin))
        (setq entmkx (entmakex new_ml))
        (entmod (append (dictsearch (namedobjdict) "ACAD_MLINESTYLE")(list (cons 3 nstname)(cons 350 entmkx))))
        (setq ret nstname)
       );_progn
     )
    )
  )
  ret
  )
(defun C:MLD ( / sset lst nst ed crs clos _J osm)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
      (if (setq nst (mknewstyle e1))
        (progn
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_ST" nst "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
          )
      )
    )
  )
  )
  (princ)
  )
(defun C:ML1 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1))
    )
  )
  )
  (princ)
  )

ML1 корректно отрабатывает при привязке _Zero

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
ML1 - практически песня!
Для 90% случаев подходит полностью (где это самое Zero или если top менняется на top)!
Небольшая проблема для линий c justification "top" (на старых, но к сожалению используемых чертежах), кои необходимо заменить линиями с "zero"!
Прога ороеделяет тип привязки для каждой "старой" линии? Можно ли этого не делать?
Насколько я  вижу (опытным путем :)) координаты вершин не зависят от привязки. Вернее привязаны там где привязаны!
Пускай пользователь (то есть я :)) разует зенки и следит как у него привязаны "старые" МЛ. И соответственно "ручками" в предустановках "текущей линии" корректирует привязку "новых" в соответствии с ситуацией!
Ни одной _CLOSE (как в мультфильме "Ну погоди!" :)) на моих планировках нет.

Re: Замена выделенных мультилиний на мультилинии другого типа.

Команда ML2 рисует Млинии без учета привязки "старой" млинии, но с учетом масштаба и замкнутости. Стиль и выравнивание - текущие. Используются ф-ции с предыдущего поста. Отличие от ML1 в комантариях ;;;

(defun C:ML2 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
;;;          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
;;;                         ((= 1 (cdr(assoc 70 ed))) "_Z")
;;;                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
;;;       (command "_MLINE" "_J" _J "_S" (cdr(assoc 40 ed)))
          (command "_MLINE" "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1))
    )
  )
  )
  (princ)
  )

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Придраться просто не к чему!
На мой взгляд  ML1 и ML2 абсолютно универсальные средства замены МЛиний на нужные пользователю!
Единственно, при поиске находил многократно повторяющиеся вопросы по смене вида (читай: замене ВСЕХ) Млиний определенного типа на чертеже на новый. Вопрос как их выбрать, если они разбросаны по слоям и весям? Можно добавить опцию выделения выбора МЛиний определенного типа перед установкой "новых". Подразумевается, что все слои разблокированы.   Для меня не очень актуально, но по несколько "старых" типов линий фиг знает где находящихся (purge не действует) на многих чертежах есть.

Re: Замена выделенных мультилиний на мультилинии другого типа.

ML3 и ML4 аналогичны ML1 и ML2 но выбирают все млинии. Все вместе

(defun massoc (key alist)
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))
(defun lst-lst-key (key lst / buf ret)
  (foreach x lst
    (if (= (car x) key)(setq ret (append ret (list buf)) buf nil))
    (setq buf (append buf (list x))))
  (setq ret (append ret (list buf))))
(defun makeUniqueMlineStyleName ( oldStile / stlist stname i)
  (setq stList (massoc 3 (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))
  (if (not (member (strcase oldStile) *MLINESTYLE*))
    (progn
      (setq i 0)
      (while (member (setq stname (strcat oldStile "-" (itoa (setq i (1+ i))))) stlist)))
    (setq stname nil)) stname)
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn (setq ls nil)
      (repeat (/ (length lst) num)
  (repeat num (setq ls
        (cons (car lst) ls)
        lst (cdr lst)))
  (setq ret (append ret (list (reverse ls)))
        ls nil)))) ret)
(defun mknewstyle ( en / stname elist opts ret _ml Mmax Mmin opts nstname new_ml entmkx)
(setq stname (strcase(cdr(assoc 2 (entget en)))))
(if (progn (setq elist nil opts nil)
      (foreach x (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
        (if (and (= (car x) 3)(= (strcase (cdr x))  stname))
          (setq opts t))
        (if opts (setq elist (append elist (list x))))
        )
      elist )
  (progn
    (setq elist (entget(cdr(assoc 350 elist))))
    (setq _ml (lst-lst-key 49 elist))
    (foreach x (cdr _ml)
      (if (or (null Mmax)
              (< (cdr(assoc 49 Mmax))(cdr(assoc 49 x)))
              )
               (setq Mmax x))
      (if (or (null Mmin)
              (> (cdr(assoc 49 Mmin))(cdr(assoc 49 x))))
                 (setq Mmin x))
      )
  (setq opts  (list
            '(0 . "MLINESTYLE")
            '(102 . "{ACAD_REACTORS")
            (cons 330 (cdr(assoc -1 (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))))
            '(102 . "}")
            '(100 . "AcDbMlineStyle")
            '(70 . 0)
            ;; End Cap Flag Values: 0 — No caps; 16 — Cap first end
            ;; 256 — Cap last end; 272 — Cap each end;
            ;; See also AutoCAD Customization Guide, Appendix C -
            ;; "ACAD_MLINESTYLE Group Codes" Table for other values
            ;;'(62 . 0) ; Fill Color, if flag 70 has 1 set
            (cons 51 (/ PI 2)) ; Start Angle
            (cons 52 (/ PI 2)) ; End Angle
        ))
    (if (setq nstname (makeUniqueMlineStyleName (cdr(assoc 2 (car _ml)))))
      (progn
        (setq *MLINESTYLE* (append *MLINESTYLE* (list nstname)))
        (setq new_ml
               (append opts
                 (list (cons 2 nstname))
                 (list (cons 71 2))
                  Mmax
                  Mmin))
        (setq entmkx (entmakex new_ml))
        (entmod (append (dictsearch (namedobjdict) "ACAD_MLINESTYLE")(list (cons 3 nstname)(cons 350 entmkx))))
        (setq ret nstname)
       );_progn
     )
    )
  )
  ret
  )
(defun C:MLD ( / sset lst nst ed crs clos _J osm)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
      (if (setq nst (mknewstyle e1))
        (progn
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_ST" nst "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
          )
      )
    )
  )
  )
  (princ)
  )
(defun C:ML1 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1))
    )
  )
  )
  (princ)
  )
(defun C:ML2 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
;;;          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
;;;                         ((= 1 (cdr(assoc 70 ed))) "_Z")
;;;                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
;;;       (command "_MLINE" "_J" _J "_S" (cdr(assoc 40 ed)))
          (command "_MLINE" "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1))
    )
  )
  )
  (princ)
  )
(defun C:ML3 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_X" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (vl-catch-all-apply 'entdel (list e1)))
    )
  )
  )
  (princ)
  )
(defun C:ML4 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_X" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
;;;          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
;;;                         ((= 1 (cdr(assoc 70 ed))) "_Z")
;;;                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
;;;       (command "_MLINE" "_J" _J "_S" (cdr(assoc 40 ed)))
          (command "_MLINE" "_S" (cdr(assoc 40 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (vl-catch-all-apply 'entdel (list e1)))
    )
  )
  )
  (princ)
  )

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Приношу извинения за свое косноязычие. :)
ML3-4 работают, но не совсем правильно!
Они меняют ВСЕ млинии, грамотно находя их на всех слоях и меняя подчистую!
Purge после этого оставляет один тип (который по умолчанию)! :)
А нужно чтобы меняли ВСЕ млинии ОДНОГО ТИПА, например "СТЕНА12" но именно так - все имеющиеся!

Re: Замена выделенных мультилиний на мультилинии другого типа.

> iv
Для этого ничего писать не нужно. ML1 и ML2 обрабатывают предварительный выбор.
1.Убеждаемся, что включен предварительный выбор
PICKFIRST -> 1
2._.QSELECT ->:
      Тип объетков -> Млиния
      Свойство     -> Стиль мультилиний
      Оператор     -> = (Равно)
      Значение     -> Твой стиль
      Отобранные объекты -> Включить в новый набор
Если нужно часто, то можно создать именованный фильтр в команде _filter

Re: Замена выделенных мультилиний на мультилинии другого типа.

А можно создать кнопку

^C^C(sssetfirst nil (ssget "_ALL" '((0 . "MLINE")(2 . "СТИЛЬ_МУЛЬТИЛИНИИ"))))

Для стиля СТЕНА12 она будет такой

(sssetfirst nil (ssget "_ALL" '((0 . "MLINE")(2 . "СТЕНА12"))))

Re: Замена выделенных мультилиний на мультилинии другого типа.

Чтобы не плодить кнопки, можно использовать следующую команду

(defun C:SELML ( / ml_st )
(defun mydcl ( zagl info-list / fl ret dcl_id)(vl-load-com)
  (if (null zagl)(setq zagl "Выбор"))
  (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
  (setq ret (open fl "w"))
  (mapcar '(lambda(x)(write-line x ret))
   (list "mip_msg : dialog { " (strcat "label=\"" zagl "\";")
      " :list_box {" "alignment=top ;"  "width=51 ;"
     (if (> (length info-list) 26) "height= 26 ;"
       (strcat "height= " (itoa(+ 3 (length info-list))) ";"))
            "is_tab_stop = false ;" "key = \"info\";}" "ok_cancel;}"))
  (setq ret (close ret))
  (if (setq dcl_id (load_dialog fl))
    (if (new_dialog "mip_msg" dcl_id)(progn
      (start_list "info")(mapcar 'add_list info-list)
      (end_list)(set_tile "info" "0")(setq ret (car info-list))
      (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
      (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
      (action_tile "accept" "(done_dialog 1)")
      (start_dialog))))(unload_dialog dcl_id) ret)
  (vl-load-com)
  (if (setq ml_st (mydcl "Выбор стиля мультилинии" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 3 (car x)))
               (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))))
  (sssetfirst nil (ssget "_ALL" (list '(0 . "MLINE")(cons 2 ml_st)))))(princ))

Создает предварительный выбор мультилиний выбранного стиля, который можно скормить ML1 или ML2. Можно создать одну кнопку, при условии, что команды загружены

^C^CSELML;ML1;Y;

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Ну что скажу... Век живи и тд!
Панель QSELECT первый раз увидел :) Был удивлен.
Функция SELML + ML 1,2 просто супер!
Готовая замена типа линий.
ML3-4 не применимы в существующем виде.
В порядке окончания темы можно предложить переделать их, чтобы по "меняли" МЛинии ОПРЕДЕЛЕННОГО ТИПА, выбранные SELML на НОВЫЙ на "своем" слое (т.е. НОВАЯ МЛ создается на слое на котором находилась "СТАРАЯ" МЛ).

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Ёпрст! Всегда найдется засада!
Когда меняешь линии, где толщина задана Scale, при моем заданнии "толщины" в единицах получается страшное!
В общем нужно чтоб не учитывал Scale "старой" линии...   Нет покоя для грешных!

Re: Замена выделенных мультилиний на мультилинии другого типа.

Если правильно понял

(defun C:ML3 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J)
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1)))))(princ))
(defun C:ML4 ( / sset lst nst ed crs clos _J osm del)
(vl-load-com)
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (initget "Yes No")
    (setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" )
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1)))))(princ))
(defun C:MLS ( / sset lst nst ed crs clos _J osm m del)
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num ) 0)(progn (setq ls nil)
(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(vl-load-com)
(initget 7)(setq m (getdist "\nNew Mline scale: "))
(initget "Yes No")(setq del (getkword "\nRemove selected object [Yes/No] <No>:"))
(if (setq sset (ssget "_:L" '((0 . "MLINE"))))
  (progn
    (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    (foreach e1 lst
          (setq ed (entget e1))
          (setq crs (group-by-num (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object e1)))) 3))
          (setq clos (= (logand (cdr(assoc 71 ed)) 2) 2))
          (setq _J (cond ((= 0 (cdr(assoc 70 ed))) "_T")
                         ((= 1 (cdr(assoc 70 ed))) "_Z")
                         (t "_B")))
          (setq osm (getvar "OSMODE"))
          (setvar "OSMODE" 0)
          (command "_MLINE" "_J" _J "_S" m "_ST" (cdr(assoc 2 ed)))
          (foreach pt crs
            (command (trans pt 0 1)))
          (command (if clos "_C" ""))
          (setvar "OSMODE" osm)
      (if del (entdel e1)))))(princ))

ML3 - аналогична ML1, ML4 - аналогична ML2 но без учета _Scale
MLS - перемасштабирование млиний

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Нельзя ли в замечательную команду SELML добавить выбор слоя, хотя бы одного из всех или хотябы галки - "не выбирать на выключенных и заблокированных слоях"? :)
В принципе последовательными QSelect - выбирается, но очень ненагладно...

Re: Замена выделенных мультилиний на мультилинии другого типа.

> iv
Не будет выбирать на выключенных и заблокированных слоях. Обрабатывает предварительный выбор. Если предварительно что-то выбрано, то поиск Млиний будет проводиться среди выбранных объектов, иначе со всего чертежа

(defun C:SELML ( / ml_st nb)
(defun mydcl ( zagl info-list / fl ret dcl_id)(vl-load-com)
  (if (null zagl)(setq zagl "Выбор"))
  (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
  (setq ret (open fl "w"))
  (mapcar '(lambda(x)(write-line x ret))
   (list "mip_msg : dialog { " (strcat "label=\"" zagl "\";")
    " :list_box {" "alignment=top ;"  "width=51 ;"
   (if (> (length info-list) 26) "height= 26 ;"
     (strcat "height= " (itoa(+ 3 (length info-list))) ";"))
            "is_tab_stop = false ;" "key = \"info\";}" "ok_cancel;}"))
  (setq ret (close ret))
  (if (setq dcl_id (load_dialog fl))
    (if (new_dialog "mip_msg" dcl_id)(progn
      (start_list "info")(mapcar 'add_list info-list)
      (end_list)(set_tile "info" "0")(setq ret (car info-list))
      (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
      (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
      (action_tile "accept" "(done_dialog 1)")
      (start_dialog))))(unload_dialog dcl_id) ret)
  (vl-load-com)(setvar "CMDECHO" 0)
  (if (and (setq ml_st (mydcl "Выбор стиля мультилинии" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 3 (car x)))
               (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))))
       (or
         (setq nb (ssget "_I" (list '(0 . "MLINE")(cons 2 (strcase ml_st)))))
         (setq nb (ssget "_ALL" (list '(0 . "MLINE")(cons 2 (strcase ml_st)))))
         )
       (setq nb (vl-remove-if '(lambda(x / ed)(setq ed (tblsearch "LAYER" (cdr(assoc 8 (entget x)))))
               (or (minusp (cdr(assoc 62 ed)))(= (logand (cdr(assoc 70 ed)) 4) 4)))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex nb))))))
    (progn
     (command "_.SELECT")(mapcar '(lambda(x)(command x)) nb)(command "")
     (sssetfirst nil (ssget "_P"))))(princ))

Re: Замена выделенных мультилиний на мультилинии другого типа.

> VVA
Маст хэв!
Не понимаю, за что народ МЛинии ругает... Теперь это вполне пристойная штука :)