Как загрузить стиль мультилинии без диалога?

{Smirnoff} · 06.03.2004, 00:03

Как можно "по тихому" загрузить без диалога стиль мультилинии?

Startrek · 12.03.2004, 02:10

commandline: MLINE ST
(command"mline" "st" "linestylename" "")

:shock: :shock:

{Smirnoff} · 12.03.2004, 10:11

А если стили мультилиний содержаться не в файле ACAD.MLN :?: :shock:

:shock: Тогда вот так, создать их:

Код:

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

(if (= nil (member (cons 3 "SC_06_CAB") ;- если нет нужного стиля мультилинии
  (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))) ;- в словаре типов мультилиний
      (progn
	(setq mlDict (cdr(assoc -1(dictsearch (namedobjdict) "ACAD_MLINESTYLE"))))
	(setq mlList '((0 . "MLINESTYLE")(102 . 
"{ACAD_REACTORS")(102 . "}") (100 . "AcDbMlineStyle") (2 . "SC_06_CAB") (70 . 0) (3 . "") 
(62 . 256) (51 . 1.5708) (52 . 1.5708) (71 . 6) (49 . 200.0) (62 . 256) (6 . 
"BYLAYER") (49 . 120.0) (62 . 256) (6 . "BYLAYER") (49 . 40.0) (62 . 256) (6 . 
"BYLAYER") (49 . -40.0) (62 . 256) (6 . "BYLAYER") (49 . -120.0) (62 . 256) (6 
. "BYLAYER") (49 . -200.0) (62 . 256) (6 . "BYLAYER"))); end setq
	(dictadd mlDict "SC_06_CAB" (entmakex mlList))
	); end progn
      ); end if

А если грузить из другого файла, о чем в общем то и был вопрос :shock: Тогда примерно так:

Код:

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

defun load_mlinestyle (flnm stname reload / *error* lst_member answer fl fl2 ckl strmus strmus2 lst_style)
  ;flnm - имя файла стиля мультилинии
  ;stname - имя стиля мультилинии
  ;reload - если не nil, то перезагрузка стиля
  (defun *error* (msg)
    (vl-catch-all-apply 'close (list fl2))
    (princ (strcat "\nОшибка в файле стиля мультилинии " flnm))
  );defun
  (if (or (not (setq lst_member (member (cons 3 stname) (setq answer (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))))
    reload
      );or
    (if (and (setq fl (findfile flnm))
       (setq fl2 (open fl "r"))
        );and
      (progn
  (read-line fl2)
  (setq ckl t)
  (while (and ckl
        (setq strmus (read-line fl2))
        (setq strmus2 (read-line fl2))
         );and
    (if (and (= (vl-string-trim " " strmus) "2")
       (= (vl-string-trim " " strmus2) stname)
        );and
      (setq ckl nil)
    );if
  );while  
        (while (and (setq strmus (read-line fl2))
        (setq strmus2 (read-line fl2))
        (/= (setq strmus (vl-string-trim " " strmus)) "0")
         );and
      (setq lst_style (cons
        (cond
          ((or (= strmus "3") (= strmus "6"))
           (cons (atoi strmus) (vl-string-trim " " strmus2))
          )
          ((or (= strmus "51") (= strmus "52"))
           (cons (atoi strmus) (* (atof (vl-string-trim " " strmus2)) (/ pi 180.0)))
          )
          (t
           (read (strcat "(" strmus " . " (vl-string-trim " " strmus2) ")"))
          )
        );cond
      lst_style))
        );while
  (close fl2)
  (if lst_style
    (progn
      (setq lst_style (append
            (list
              '(0 . "MLINESTYLE")
              (cons 330 (cdr (assoc -1 answer)))
              '(100 . "AcDbMlineStyle")
        (cons 2 stname))
            (reverse lst_style)))
      (if lst_member
        (entmod (subst (cons 350 (entmakex lst_style)) (cadr lst_member) answer))
        (entmod (append answer (list (cons 3 stname) (cons 350 (entmakex lst_style)))))
      );if
    );progn
  );if
      );progn
    );if
    answer
  );if
);defun

Прошу прощения за неточно сформулированный вопрос. Имелось ввиду, ЛЮБОЙ СТИЛЬ из ЛЮБОГО ФАЙЛА.

GadjUI · 13.01.2011, 17:07

Великолепно!
А как загрузить стиль мультилинии из acad.mln программой, написанной на VBA?

Олег (jr.) · 14.01.2011, 01:40

Цитата:

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

Великолепно!
А как загрузить стиль мультилинии из acad.mln программой, написанной на VBA?

Не нашел до сих пор решения на VBA:
http://www.caduser.ru/forum/index.ph...#message186977
Возможное решение черезWin API по примеру:
http://through-the-interface.typepad...ques_for_.html

Олег (jr.) · 15.01.2011, 01:49

Цитата:

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

Великолепно!
А как загрузить стиль мультилинии из acad.mln программой, написанной на VBA?

Вот попробуй такой ...код с костылем
(неохота лезть в Win API)

Код:

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

Option Explicit
'~~~~~~~~~~~ credits to Kean Walmsey ~~~~~~~~~~'
Private Const WM_COPYDATA = &H4A


Private Type COPYDATASTRUCT

    dwData As Long

    cbData As Long

    lpData As String

End Type

Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Sub SendMessageToAutoCAD(ByVal message As String)

    Dim data As COPYDATASTRUCT

    Dim str As String

    str = StrConv(message, vbUnicode) 'converts to Unicode


    data.dwData = &H1

    data.lpData = str

    data.cbData = (Len(str) + 2)
    

Call SendMessage(ThisDrawing.Application.hwnd, WM_COPYDATA, 0&, data)

End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Public Sub Loadmln()
ThisDrawing.SetVariable "CMDECHO", 0
ThisDrawing.SetVariable "FILEDIA", 0
ThisDrawing.SetVariable "CMDDIA", 0
ThisDrawing.SetVariable "QAFLAGS", 31

On Error GoTo Err_Message

On Error Resume Next

SendMessageToAutoCAD "_mline st boo  "              ''<--"BOO" is desired mline style name
SendMessageToAutoCAD Chr(27) & Chr(27) & Chr(27)
MsgBox "Нажми ENTER когда появится окно стилей"

If Err Then
Err.Clear
End If
On Error GoTo 0

Exit_Here:
ThisDrawing.SetVariable "FILEDIA", 1
ThisDrawing.SetVariable "CMDDIA", 1
ThisDrawing.SetVariable "QAFLAGS", 0
ThisDrawing.SetVariable "CMDECHO", 1
Exit Sub

Err_Message:
 If Err.Number <> 0 Then
 MsgBox Err.Description
 Err.Clear
 End If
 Resume Exit_Here

End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

АлексЮстасу · 15.01.2011, 15:21

У меня программка load_mlinestyle из поста 2 ровно ничего не делает.
Запускаю так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.dxf M200-34_M-_M-_M- reload)),
или так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.dxf M200-34_M-_M-_M- 1)),
или так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.mln M200-34_M-_M-_M- 1)),
или так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.mln M200-34_M-_M-_M- reload)).
Ни сообщений, ни ошибок, стиль не добавляется.
Что-то я не то делаю?

И, кстати, можно было бы сделать так, чтобы загружать не конкретный стиль мультилиний, а по маске? Или сразу все?

Олег (jr.) · 15.01.2011, 15:30

Цитата:

Сообщение от АлексЮстасу

У меня программка load_mlinestyle из поста 2 ровно ничего не делает.
Запускаю так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.dxf M200-34_M-_M-_M- reload)),
или так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.dxf M200-34_M-_M-_M- 1)),
или так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.mln M200-34_M-_M-_M- 1)),
или так:
(load_mlinestyle (D:\Мультилинии\Общие_назнвания\мультилинии_2000.mln M200-34_M-_M-_M- reload)).
Ни сообщений, ни ошибок, стиль не добавляется.
Что-то я не то делаю?

И, кстати, можно было бы сделать так, чтобы загружать не конкретный стиль мультилиний, а по маске? Или сразу все?

|Аргумет имя файла должен быть в кавычках и с двойными бэкслэшами:
"D:\\Мультилинии\\Общие_назнвания\\мультилинии_2000.mln"

Скинь .MLN файл для теста
Какая версия Автокадв?

АлексЮстасу · 15.01.2011, 16:10

Цитата:

Сообщение от Олег (jr.)

|Аргумет имя файла должен быть в кавычках и с двойными бэкслэшами:
"D:\\Мультилинии\\Общие_назнвания\\мультилинии_2000.mln"

Скинь .MLN файл для теста
Какая версия Автокадв?

Кавычки и слеши пока не помогли.
Названия мультилиний тоже в кавычках? И писать прямо reload или цифру какую?
Автокад 2008.

Олег (jr.) · 15.01.2011, 21:44

Юзай

Код:

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

;; lmst.lsp
(defun load_mlinestyle (flnm stname reload / *error* lst_member answer fl fl2 ckl strmus strmus2 lst_style)
  ;flnm - имя файла стиля мультилинии
  ;stname - имя стиля мультилинии
  ;reload - если не nil, то перезагрузка стиля
  ;автор: Александр Смирнов aka {Smirnoff} aka Fantomas
  (defun *error* (msg)
    (vl-catch-all-apply 'close (list fl2))
    (princ (strcat "\nОшибка в файле стиля мультилинии " flnm))
  );defun
  (if (or (not (setq lst_member (member (cons 3 stname) (setq answer (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))))
    reload
      );or
    (if (and (setq fl (findfile flnm))
       (setq fl2 (open fl "r"))
        );and
      (progn
  (read-line fl2)
  (setq ckl t)
  (while (and ckl
        (setq strmus (read-line fl2))
        (setq strmus2 (read-line fl2))
         );and
    (if (and (= (vl-string-trim " " strmus) "2")
       (= (vl-string-trim " " strmus2) stname)
        );and
      (setq ckl nil)
    );if
  );while  
        (while (and (setq strmus (read-line fl2))
        (setq strmus2 (read-line fl2))
        (/= (setq strmus (vl-string-trim " " strmus)) "0")
         );and
      (setq lst_style (cons
        (cond
          ((or (= strmus "3") (= strmus "6"))
           (cons (atoi strmus) (vl-string-trim " " strmus2))
          )
          ((or (= strmus "51") (= strmus "52"))
           (cons (atoi strmus) (* (atof (vl-string-trim " " strmus2)) (/ pi 180.0)))
          )
          (t
           (read (strcat "(" strmus " . " (vl-string-trim " " strmus2) ")"))
          )
        );cond
      lst_style))
        );while
  (close fl2)
  (if lst_style
    (progn
      (setq lst_style (append
            (list
              '(0 . "MLINESTYLE")
              (cons 330 (cdr (assoc -1 answer)))
              '(100 . "AcDbMlineStyle")
        (cons 2 stname))
            (reverse lst_style)))
      (if lst_member
        (entmod (subst (cons 350 (entmakex lst_style)) (cadr lst_member) answer))
        (entmod (append answer (list (cons 3 stname) (cons 350 (entmakex lst_style)))))
      );if
    );progn
  );if
      );progn
    );if
    answer
  );if
);defun

(defun C:LMST	(/ fname mline_list)

(command "_undo" "_begin")

  (setvar "filedia" 1)
  ;; Выбираешьфайл  MLN :
  (setq fname (getfiled "Select a LiineType File" (getvar "dwgprefix") "mln" 4))
  ;;или прописываешь полное имя файла:
;;;  (setq fname "D:\\Мультилинии\\Общие_назнвания\\мультилинии_2000.mln") ;<---'назнвания' - это синтаксическая ошибка???


  ;;составляешь список мультилиний, которые нужно загрузить:
  
  (setq mline_list (list "M00-" "M131-" "M132-"))
  ;;Грузишь весь список:
  (foreach item mline_list
  (load_mlinestyle fname item nil);<-- nil чтобы не загружать существующий стиль
    )
    ;;Или то же самое:
;;;   (mapcar
;;;    (function (lambda(m) (load_mlinestyle fname m nil)))
;;;    mline_list))
    (command "_undo" "_end")

  (princ)
  )
 ;;=================================;;
(prompt "\n\t***\tВедите LMST для загрузки стилей мультилинии\t***")
(prin1)

АлексЮстасу · 15.01.2011, 23:40

Цитата:

Сообщение от Олег (jr.)

Юзай

Поюзал!
Конкретно из того файла, который я выкладывал, мультилинии грузит, а из других - нет.
Может быть дело с строках:

;;составляешь список мультилиний, которые нужно загрузить:

(setq mline_list (list "M00-" "M131-" "M132-"))
;;Грузишь весь список:

Олег (jr.) · 16.01.2011, 12:11

Цитата:

Сообщение от АлексЮстасу

Поюзал!
Конкретно из того файла, который я выкладывал, мультилинии грузит, а из других - нет.
Может быть дело с строках:

;;составляешь список мультилиний, которые нужно загрузить:

(setq mline_list (list "M00-" "M131-" "M132-"))
;;Грузишь весь список:

Правильно, составь другой список, можно сделать диалог с выбором
соответствующих стилей, только у меня нет времени на это

АлексЮстасу · 16.01.2011, 13:05

Цитата:

Сообщение от Олег (jr.)

Правильно, составь другой список, можно сделать диалог с выбором
соответствующих стилей, только у меня нет времени на это

Без претензиев.
Только я ну совсем не программист. Я здесь, потому что меня интересует тема работы с мультилиниями.
А что с лиспом из #3? Он работоспособен? Или я неправильно его запускаю?

GadjUI · 17.01.2011, 17:15

Олег (Jr.) пишет:
"Вот попробуй такой ...код с костылем
(неохота лезть в Win API)"...

Я выполняю немного другой код:
Namm - содержит название типа мультилинии - "ЖЕЛЕЗКА"
Dimm - содержит директорию - D:\SaRoad\SaRoad.mln

Код:

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

    
    Dim RetPnt As Variant
    On Error Resume Next
    RetPnt = ThisDrawing.Utility.GetPoint(, "Укажи начало мультилинии - " & Namm & " >")
    If Err.Number <> 0 Then GoTo EndSub
    If IsNull(RetPnt(0)) Then
        GoTo EndSub
    Else
        X = CDbl(RetPnt(0)) ' -- X координата --
        Y = CDbl(RetPnt(1)) ' -- Y координата --
    End If
    On Error GoTo 0
    ' --- рисуем МУЛЬТИЛИНИЮ ---
    a = "_st" & vbCr & Namm & vbCr    ' стиль  Namm = "ЖЕЛЕЗКА"
    a = a & "_s" & vbCr & "1" & vbCr  ' максштаб
    a = a & Replace(CStr(X), ",", ".") & "," & Replace(CStr(Y), ",", ".") & vbCr
    ThisDrawing.SendCommand "_Mline" & vbCr & CStr(a)
EndSub:

Автокад начинает рисовать мультилинию нужного стиля, но если стиль не был предварительно загружен, выскакивает окно навигатора и просит указать путь к файлу D:\saroad\saroad.mln.

Я то этот путь уже знаю заранее (Dirr) и хотелось бы избежать лишних вопросов со стороны AutoCAD - и прямо в программе указать где нужно искать стиль. Но пока увы и ах...

06.03.2004, 00:03		#1
Как загрузить стиль мультилинии без диалога? {Smirnoff} Инженер по системам безопасности Рига Регистрация: 23.11.2003 Сообщений: 1,099 Как можно "по тихому" загрузить без диалога стиль мультилинии?
Просмотров: 8269