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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Требуется помощь,что бы Mleader не опускался

Требуется помощь,что бы Mleader не опускался

Ответ
Поиск в этой теме
Непрочитано 07.11.2008, 19:04
Требуется помощь,что бы Mleader не опускался
Composter
 
Отопление и вентиляция
 
Москва
Регистрация: 31.10.2008
Сообщений: 445

я впервые столкнулся с 2009 автокадом и решил попробовать мультивыноски. активно ими пользовался и практически сразу заметил что определенные символы опускают текст на несколько миллиметров , у меня например а(русская прописная), a(английская прописная), и цифра 9, (наблюдается если использовать шрифт gost 2.304 type A , которым я пользовался).Это исправляется если в конце текста добавить 2 строку и изменить высоту этой строки. Так как мультивыносок много, то на исправление вручную уйдет несколько дней. Теперь о макросе.
Далее, собственно, как я вижу предстоящую программу:
-при щелканье на мультиссылке (я знаю что команда ddedit открывает текст мультиссылки для редактирования, хотя текст в мссылке мульти, а не однострочный) что бы в конце текста добавлялись определенные символы (в данном случае переход на другую строку с пробелом, измененной высоты)
Особые пожелания:
-что бы запрашивала прога какие я хочу символы добавлять
-что бы запрашивала прога высоту шрифта добавляемой строки
-что бы можно было сразу кучу мультиссылок исправлять таким образом, а не щелкать отдельно по каждой .
В общем, очень надеюсь на помощь специалистов, ради написания данной програмки сел изучать автолисп, но пока знание довольно сыроваты ) Заранее спасибо
---
Одно из возможных решений (спасибо VVA)

Последний раз редактировалось Кулик Алексей aka kpblc, 08.12.2012 в 22:33.
Просмотров: 29478
 
Непрочитано 13.11.2008, 15:32
#41
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


ShaggyDoc, ну в общем-то снесение форматирование именно здесь переписано частично (VVA предложение пока не отсылал). А что фонт может быть кривой - так я и не спорю...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.11.2008, 22:34
#42
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Намек запущен. Проверяй
Цитата:
Сообщение от wetr Посмотреть сообщение
Что за ... этот мультитекст.
Алексей, не подскажешь, где можно покопаться?
В общем мультилидер ведет себя "неожиданно", выставляя текст на разной высоте. Закономерности какие-то есть, текст реагирует на различные символы, и в зависимости об этого ставит всю строку выше или ниже. Насколько я понял, от шрифта мало что зависит. Где можно посмотреть настройки мтекста, чтобы попробовать выявить закономерности "пляски" текста над полкой? Где-то читал, что это даже не полка а подчеркивание. В "дампе" текста очень мало свойств.
Код:
[Выделить все]
_$ (setq obj (vlax-ename->vla-object (car(entsel))))
(vlax-dump-Object obj)
#<VLA-OBJECT IAcadMText 130d6a7c>
; IAcadMText: AutoCAD MText Interface
; Property values:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00cd63f8>
;   AttachmentPoint = 1
;   BackgroundFill = 0
;   Document (RO) = #<VLA-OBJECT IAcadDocument 208c9f78>
;   DrawingDirection = 5
;   Handle (RO) = "269"
;   HasExtensionDictionary (RO) = 0
;   Height = 2.5
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 43bba44c>
;   InsertionPoint = (1416.22 699.236 0.0)
;   Layer = "_Тексты"
;   LineSpacingDistance = 3.33333
;   LineSpacingFactor = 0.8
;   LineSpacingStyle = 2
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Material = "ByLayer"
;   Normal = (0.0 0.0 1.0)
;   ObjectID (RO) = 2116860040
;   ObjectName (RO) = "AcDbMText"
;   OwnerID (RO) = 2116852984
;   PlotStyleName = "ByLayer"
;   Rotation = 0.0
;   StyleName = "Standard"
;   TextString = "\\pxsm0.6;Кусок\r\\P\\ps*;строки\r\\Pвапр"
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 427941e0>
;   Visible = -1
;   Width = 41.4809
T
У мтекста есть еще какие-то коды
Mtext group codes
Из справки

Код 44 - это как раз тот самый коэфициент, который мы присваиваем. Ты своей программой его меняешь или в форматирование текста вставляешь?
По идее 44 код тебе не требуется - см. свойства LineSpacingFactor и LineSpacingDistance. Кажется, их достаточно.
Я эти коды не меняю. Я меняю содержимое текстовой строки.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.11.2008, 02:47
#43
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от ShaggyDoc Посмотреть сообщение
[url="http://forum.dwg.ru/member.php?u=28"]
Но здесь в основе всё-таки неправильный шрифт. Это явно из CS стандартный. У него описание некорректное. Я так думаю.
если вы про мой файл, то там шрифт mipgost.shx от VVA.
А вообще, по опыту использования мультилидера, изменение шрифта не спасает ситуацию. Да и людей уже очень много высказывалось, по поводу этой проблемы. Не думаю что у всех один шрифт. Получается все шрифты кривые? И как выход нужно сделать новый font спецально для мультилидера?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 14.11.2008, 02:49
#44
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Кулик Алексей aka kpblc,
Спасибо все работает.
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 14.11.2008, 06:31
#45
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Цитата:
Получается все шрифты кривые? И как выход нужно сделать новый font спецально для мультилидера?
Нет, не все. Проблему с подчеркиванием верхней строки я заметил, только когда заменил в текстовом стиле simplex.shx на CS_Gost2304.shx. Этот шрифт более подходящий, да и дополнительные символы есть.

Потом, экспериментируя с разными шрифтами, убедился, что именно так. Можете попробовать. Только надо учитывать, что имеются одноименные шрифты разных разработчиков. Новый фонт делать, конечно не стоит, надо просто подобрать правильный. Конечно, авторы CS_Gost2304.shx не стремились сделать плохой шрифт, наоборот. Просто тогда еще мультивыносок не было.

У Аутодеск тоже рыльце в пушку. Мультивыноски себя иногда ведут непредсказуемо. Попробуйте, например, чуть-чуть перенести выноску за начало полки. Текст может приподняться. А может опуститься. Но не всегда.

Хорошего решения пока не нашлось. Эксперименты с LineSpacingDistance, LineSpacingFactor, LineSpacingStyle пока не дают однозначно правильного результата для любого шрифта. Не нашлось пока и правильного шрифта с полным набором символов, хотя и не искал специально.

Но и вставка в строку дополнительных тегов форматирования не выход, хотя это сделать проще всего. Выход все-таки в подборе шрифта. Тогда достаточно дать ему такое имя, какое есть в существующих чертежах и проблема будет решена без всяких махинаций.
ShaggyDoc вне форума  
 
Непрочитано 14.11.2008, 06:44
#46
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


ShaggyDoc, обалдеть!!! Вы как в воду глядели. Я тут в другой теме
начал эксперементировать. И вот что вышло - шрифт не должен содержать дуги.
Например txt - отображается изумительно!!!
Я для себя уже даже нашел поджодящий - GOST.shx от VetalBY. Даже не нашел - вспомнил Раньше я им лет 5 пользовался.
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 17.11.2010, 11:59
#47
Astartes

Котло- и реакторостроение
 
Регистрация: 25.02.2010
Барнаул
Сообщений: 807


Кулик Алексей aka kpblc, wetr,
Объясните пожалуйста, что в лиспе нужно поменять чтобы Paragrapf Line Spacing (ссылка) стал равен 5. Если применить код как он есть, то у меня значении 4,666. Шрифт Simplex.
И еще если у меня текст с нижним индексом(дробный), например, А1, то после применения лиспа к мультивыноске, текст возвращается в исходное состояние, т.е. А^1.
Можно ли это сделать так что дробная часть не изменялась.
Astartes вне форума  
 
Непрочитано 17.11.2010, 19:12
#48
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Astartes,
Посмотри эту тему: Mеждустрочное расстояние в MTEXT
wetr, Я в опытном режиме использую старый (с дугами) шрифт mipgost, программно приподнимая шрифт с помощью форматирования \\pxse (см ссылку)
*** Добавлено
Перенесен старый вариант
Код:
[Выделить все]
;;;http://forum.dwg.ru/showthread.php?t=26548&page=3
;;; Где изменить значение междустрочного значения интервала параграфа
;;; в реакторе на мультилидер?
;;; искать строчку   (mtext-paragraph "\\pxse" 0.86667 (entlast))
;;; в ней менять число 0.86667 на нужное

(defun le-endCommand (CALL CALLBACK)
  (if (= (strcase (car CALLBACK)) "MLEADER")
  (mtext-paragraph "\\pxse" 0.86667 (entlast)) ;;;Здесь меняют значение междустрочного интервала параграфа !!!
 )
)

(defun gc:FieldCode (ent / foo elst xdict dict field str)
  ;; credits gile
  (defun foo (field str / pos fldID objID)
    (setq pos 0)
    (if (setq pos (vl-string-search "\\_FldIdx " str pos))
      (while (setq pos (vl-string-search "\\_FldIdx " str pos))
        (setq fldId (entget (cdr (assoc 360 field)))
              field (vl-remove (assoc 360 field) field)
              str   (strcat
                      (substr str 1 pos)
                      (if (setq objID (cdr (assoc 331 fldId)))
                        (vl-string-subst
                          (strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
                          "ObjIdx"
                          (cdr (assoc 2 fldId))
                        )
                        (foo fldId (cdr (assoc 2 fldId)))
                      )
                      (substr str (1+ (vl-string-search ">%" str pos)))
                    )
        )
      )
      str
    )
  )
    ;; gc:EnameToObjectId (gile)
;; Returns the ObjectID from an ename
;;
;; Argument : an ename

(defun gc:EnameToObjectId (ename)
  ;; credits gile
  ((lambda (str)
     (hex2dec
       (substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
     )
   )
    (vl-princ-to-string ename)
  )
)
    ;;============================================================;;

;; hex2dec (gile)
;; convert an hexadecimal into a decimal (int)
;;
;; Argument : un hexadedimal (string)

(defun hex2dec (s / r l n)
  (setq	r 0 l (vl-string->list (strcase s)))
  (while (setq n (car l))
    (setq l (cdr l)
          r (+ (* r 16) (- n (if (<= n 57) 48 55)))
    )
  )
)
  ;;--------------------------------------------------------;;
  
  (setq elst (entget ent))
  (if (vlax-property-available-p (vlax-ename->vla-object ent) 'Textstring)
    (setq str (vla-get-TextString (vlax-ename->vla-object ent)))
    )
  (if (and
	(member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
	(setq xdict (cdr (assoc 360 elst)))
	(setq dict (dictsearch xdict "ACAD_FIELD"))
	(setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
      )
    (setq str (foo field (cdr (assoc 2 field))))
  )
    str
)
(defun isFieldAvailable ( obj  / fc )
  (if (= (type obj) 'ENAME)
      (setq obj (vlax-ename->vla-object obj))
    )
  (and
    (setq fc (vla-GetExtensionDictionary  obj))
    (setq fc (vlax-vla-object->ename fc))
    (dictsearch fc "ACAD_FIELD")
    )
 )
(defun mtext-paragraph ( pat value obj / ss i mtext ent)
;;; MText Line Spacing
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Spacing
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора
  ;; pat "\\pxse" or "\\pxsm"
  ;; (setq value 0.86667)
  ;; (mtle 0.86667 (entlast))
  (vl-load-com)
  (setq value (rtos value 2 5))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (setq ent (vlax-vla-object->ename obj))
  (if (and (vlax-write-enabled-p obj)
        (vlax-property-available-p obj 'Textstring)
                 (or (not (vlax-property-available-p obj 'MTextAttribute))
                     (and (vlax-property-available-p obj 'MTextAttribute)
                          (eq (vla-get-MTextAttribute obj) :vlax-true)
                          )
                     )
                 )
          (progn
            (setq mtext (gc:FieldCode ent))
            (if (not(setq i (vl-string-search "\\PX" (strcase mtext))))
              (setq i 0)
              )
            (if (wcmatch (strcase (substr mtext (1+ i) 3)) "\\PX")  ;;;абзац и междустрочный интервал \\PX[QITSBA]
              (setq mtext
                  (strcat (if (not (zerop i))(substr mtext 1 i) "")
                  pat value ";"
                  (substr mtext (+ 2 (vl-string-search ";" mtext i))))
                    )
              (setq mtext (strcat pat value ";" mtext))
              )
            (vla-put-TextString obj mtext)
            (if (isFieldAvailable obj)
              (progn
                (vl-cmdf "_.updatefield" ent "")
                (entupd ent)
                )
              )
            )
        )
  )

(defun C:MTLS ( / ss i lst mtext ls *LS*)
;;; MText Line Spacing
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Spacing
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора  
  (vl-load-com)
  (if (zerop
      (setq
        *LS* (abs
               (atof (vl-princ-to-string (getcfg "AppData/MTEXTLS/LS")))
             ) ;_ end of abs
      ) ;_ end of setq
    ) ;_ end of zerop
  (setq *LS* 1)
) ;_ end of if
  (if (and
        (progn
          (initget 6)
          (princ "\nEnter line spasing value <")
          (princ *LS*)
          (princ ">: ")
          (if (setq ls (getreal))
            (progn
              (setq *LS* ls)
              (setcfg "AppData/MTEXTLS/LS" (rtos *LS* 2 2))
              )
            (setq ls *LS*)
            )
        )
        (setq lst nil ss (ssget "_:L" '((0 . "MTEXT,ATTDEF,INSERT,MULTILEADER"))))
        (repeat (setq i (sslength ss)) ;_ end setq
         (setq lst (cons (ssname ss (setq i (1- i))) lst))
         ) ;_ en
        )
    (progn
      (setq ss nil)
      (foreach itm lst
        (if (and itm (setq itm (vlax-ename->vla-object itm))
           (vlax-property-available-p itm 'Hasattributes)
	   (eq :vlax-true (vla-get-HasAttributes itm))
                 )
          (setq ss (append ss
                           (mapcar 'vlax-vla-object->ename
                           (append (vlax-invoke itm 'Getattributes)(vlax-invoke itm 'Getconstantattributes))
                                   )
                           )
                )
		  )
        )
      (setq lst (append lst ss))
      (foreach itm lst (mtext-paragraph "\\pxsm" ls itm))
    )
    )
  (princ)
)
(defun C:MTLE ( / ss i lst mtext ls *LE*)
;;; MText Line Equal
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Equal
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора  
  (vl-load-com)
  (if (zerop
      (setq
        *LE* (abs
               (atof (vl-princ-to-string (getcfg "AppData/MTEXTLS/LE")))
             ) ;_ end of abs
      ) ;_ end of setq
    ) ;_ end of zerop
  (setq *LE* 1)
) ;_ end of if
  (if (and
        (progn
          (initget 6)
          (princ "\nEnter line spasing (equal) value <")
          (princ *LE*)
          (princ ">: ")
          (if (setq ls (getreal))
            (progn
              (setq *LE* ls)
              (setcfg "AppData/MTEXTLS/LE" (rtos *LE* 2 2))
              )
            (setq ls *LE*)
            )
        )
        (setq lst nil ss (ssget "_:L" '((0 . "MTEXT,ATTDEF,INSERT,MULTILEADER"))))
        (repeat (setq i (sslength ss)) ;_ end setq
         (setq lst (cons (ssname ss (setq i (1- i))) lst))
         ) ;_ en
        )
    (progn
      (setq ss nil)
      (foreach obj lst
        (if (and obj (setq obj (vlax-ename->vla-object obj))
           (vlax-property-available-p obj 'Hasattributes)
	   (eq :vlax-true (vla-get-HasAttributes obj))
                 )
          (setq ss (append ss
                           (mapcar 'vlax-vla-object->ename
                           (append (vlax-invoke obj 'Getattributes)(vlax-invoke obj 'Getconstantattributes))
                                   )
                           )
                )
		  )
        )
      (setq lst (append lst ss))
      (foreach itm lst (mtext-paragraph "\\pxse" ls itm))
    )
    )
  (princ)
)
  
  

(defun C:VLR_MTLE_ON ()
  (vl-load-com)
  (or *vlr-MTLE
     (setq *vlr-MTLE (vlr-command-reactor nil '((:vlr-commandEnded . le-endCommand)))))
  (princ "\nMtex Line Equal Reactor ON")
  (setvar "MODEMACRO" (strcat "*LE* "(VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO"))))
  (princ)
)


;;  Turn the reactors off
(defun C:VLR_MTLE_OFF ()
  (and *vlr-MTLE (vlr-added-p *vlr-MTLE) (vlr-remove *vlr-MTLE))
  (setvar "MODEMACRO" (VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO")))
  (princ "\nMtex Line Equal Reactor OFF")
  (princ)
)
(princ "\nType MTLE, MTLS, VLR_MTLE_ON, VLR_MTLE_OFF in command line")
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 31.05.2011 в 20:19.
VVA вне форума  
 
Непрочитано 18.11.2010, 02:03
#49
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


VVA, а если реактором это сделать, чтобы пользователь даже ничего не знал про этот глюк?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 18.11.2010, 05:23
#50
Astartes

Котло- и реакторостроение
 
Регистрация: 25.02.2010
Барнаул
Сообщений: 807


VVA, Спасибо большое, то что нужно.
Astartes вне форума  
 
Непрочитано 18.11.2010, 20:20
3 | #51
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Astartes Посмотреть сообщение
VA, а если реактором это сделать, чтобы пользователь даже ничего не знал про этот глюк?
Цитата:
Сообщение от wetr Посмотреть сообщение
Диалог программы примерно такой
Введите междустрочный интервал параграфа:...
Выберете выноски <Все>: ...
ОК!
Вот что по быстрому наваял. За основу взял команду MTLS по ссылке из #48
4 команды
MTLS - изменяет междустрочный интервал, режим "несколько" (форматирование \\pxsm)
MTLE - изменяет междустрочный интервал, режим "точно" (форматирование \\pxse)
VLR_MTLE_ON - стартует (активирует) реактор на мультилидер
VLR_MTLE_OFF - останавливает (деактивирует) реактор
Признаком активности реактора - строчка *LE* в modemacro (если кому не понятно - слева внизу экрана)

Добавлено форматирование для опускания 2-го параграфа (см #61)
Код:
[Выделить все]
;;;http://forum.dwg.ru/showthread.php?t=26548&page=3
;;; Где изменить значение междустрочного значения интервала параграфа
;;; в реакторе на мультилидер?
;;; искать строчку   (mtext-paragraph  0.86667 0.25 (entlast))
;;; в ней менять число 0.86667 на нужное
;;;Если нужно активизировать реактор при загрузке уберите ;;; из последней строчки ;;;(C:VLR_MTLE_ON)
(defun le-endCommand (CALL CALLBACK)
  (if (= (strcase (car CALLBACK)) "MLEADER")
  (mtext-paragraph 0.86667 0.25 (entlast)) ;;;Здесь меняют значение междустрочного интервала параграфа !!!
 )
)
(defun C:MTLE ( / ss i lst mtext ls *LE*)
;;; MText Line Equal
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Equal
;;; http://forum.dwg.ru/showthread.php?t=26548&page=3 
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; http://www.cadtutor.net/forum/showthread.php?54332-make-objects-as-block/page2
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора  
  (vl-load-com)
  (if (zerop
      (setq
        *LE* (abs
               (atof (vl-princ-to-string (getcfg "AppData/MTEXTLS/LE")))
             ) ;_ end of abs
      ) ;_ end of setq
    ) ;_ end of zerop
  (setq *LE* 1)
) ;_ end of if
  (if (and
        (progn
          (initget 6)
          (princ "\nEnter line spasing (equal) value <")
          (princ *LE*)
          (princ ">: ")
          (if (setq ls (getreal))
            (progn
              (setq *LE* ls)
              (setcfg "AppData/MTEXTLS/LE" (rtos *LE* 2 2))
              )
            (setq ls *LE*)
            )
        )
      ;;;  (setq lst nil ss (ssget "_:L" '((0 . "MTEXT,ATTDEF,INSERT,MULTILEADER"))))
       (setq lst nil ss (ssget "_:L" '((0 . "MULTILEADER"))))
        (repeat (setq i (sslength ss)) ;_ end setq
         (setq lst (cons (ssname ss (setq i (1- i))) lst))
         ) ;_ en
        )
    (progn
      (setq ss nil)
      (foreach obj lst
        (if (and obj (setq obj (vlax-ename->vla-object obj))
           (vlax-property-available-p obj 'Hasattributes)
	   (eq :vlax-true (vla-get-HasAttributes obj))
                 )
          (setq ss (append ss
                           (mapcar 'vlax-vla-object->ename
                           (append (vlax-invoke obj 'Getattributes)(vlax-invoke obj 'Getconstantattributes))
                                   )
                           )
                )
		  )
        )
      (setq lst (append lst ss))
      (foreach itm lst (mtext-paragraph  ls 0.25 itm))
    )
    )
  (princ)
)
  
(defun C:MTLS ( / ss i lst mtext ls *LS*)
;;; MText Line Spacing
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Spacing
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора  
  (vl-load-com)
  (if (zerop
      (setq
        *LS* (abs
               (atof (vl-princ-to-string (getcfg "AppData/MTEXTLS/LS")))
             ) ;_ end of abs
      ) ;_ end of setq
    ) ;_ end of zerop
  (setq *LS* 1)
) ;_ end of if
  (if (and
        (progn
          (initget 6)
          (princ "\nEnter line spasing value <")
          (princ *LS*)
          (princ ">: ")
          (if (setq ls (getreal))
            (progn
              (setq *LS* ls)
              (setcfg "AppData/MTEXTLS/LS" (rtos *LS* 2 2))
              )
            (setq ls *LS*)
            )
        )
        (setq lst nil ss (ssget "_:L" '((0 . "MTEXT,ATTDEF,INSERT,MULTILEADER"))))
        (repeat (setq i (sslength ss)) ;_ end setq
         (setq lst (cons (ssname ss (setq i (1- i))) lst))
         ) ;_ en
        )
    (progn
      (setq ss nil)
      (foreach itm lst
        (if (and itm (setq itm (vlax-ename->vla-object itm))
           (vlax-property-available-p itm 'Hasattributes)
	   (eq :vlax-true (vla-get-HasAttributes itm))
                 )
          (setq ss (append ss
                           (mapcar 'vlax-vla-object->ename
                           (append (vlax-invoke itm 'Getattributes)(vlax-invoke itm 'Getconstantattributes))
                                   )
                           )
                )
		  )
        )
      (setq lst (append lst ss))
      (foreach itm lst (mtext-paragraph ls nil itm))
    )
    )
  (princ)
)  

(defun C:VLR_MTLE_ON ()
  (vl-load-com)
  (or *vlr-MTLE
     (setq *vlr-MTLE (vlr-command-reactor nil '((:vlr-commandEnded . le-endCommand)))))
;;;  (or *vlr-CC
;;;     (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))))
  (princ "\nMtex Line Equal Reactor ON")
  (setvar "MODEMACRO" (strcat "*LE* "(VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO"))))
  (princ)
)

;;  Turn the reactors off
(defun C:VLR_MTLE_OFF ()
  (and *vlr-MTLE (vlr-added-p *vlr-MTLE) (vlr-remove *vlr-MTLE))
  (setvar "MODEMACRO" (VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO")))
  (princ "\nMtex Line Equal Reactor OFF")
  (princ)
)
(defun isFieldAvailable ( obj  / fc )
  (if (= (type obj) 'ENAME)
      (setq obj (vlax-ename->vla-object obj))
    )
  (and
    (setq fc (vla-GetExtensionDictionary  obj))
    (setq fc (vlax-vla-object->ename fc))
    (dictsearch fc "ACAD_FIELD")
    )
 )
(defun mip-conv-to-str (dat)
      (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
            ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
            ((null dat) (setq dat ""))
            (t (setq dat (vl-princ-to-string dat)))
      ) ;_ end of cond
    ) ;_ end of def

(defun mtext-paragraph (value abz obj / ss i mtext ent pat)
;;; MText Line Spacing
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Spacing
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора
;;; value - значение междустрочного интервала параграфа ( положительное - форматирование \\pxse, отрицательное - форматирование \\pxsm ) или nil - нет
;;; abz - значение абзаца (форматирование \\pxa ) или nil - нет
  (vl-load-com)
  ;;(setq value (rtos value 2 5))
  (setq pat (strcat "\\px"
                              (if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (mip-conv-to-str abz))",") "")
                              "se" (VL-STRING-RIGHT-TRIM "0" (mip-conv-to-str value))";"))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (setq ent (vlax-vla-object->ename obj))
  (if (and (vlax-write-enabled-p obj)
        (vlax-property-available-p obj 'Textstring)
                 (or (not (vlax-property-available-p obj 'MTextAttribute))
                     (and (vlax-property-available-p obj 'MTextAttribute)
                          (eq (vla-get-MTextAttribute obj) :vlax-true)
                          )
                     )
                 )
          (progn
            (setq mtext (bg:FieldCode ent))
            (if (not(setq i (vl-string-search "\\PX" (strcase mtext))))
              (setq i 0)
              )
            (if (wcmatch (strcase (substr mtext (1+ i) 3)) "\\PX")  ;;;абзац и междустрочный интервал \\PX[QITSBA]
              (setq mtext
                  (strcat (if (not (zerop i))(substr mtext 1 i) "")
                  pat  
                  (substr mtext (+ 2 (vl-string-search ";" mtext i))))
                    )
              (setq mtext (strcat pat mtext))
              )
            (vla-put-TextString obj mtext)
            (if (isFieldAvailable obj)
              (progn
                (vl-cmdf "_.updatefield" ent "")
                (entupd ent)
                )
              )
            )
        )
  )

(defun bg:FieldCode (ent / foo elst xdict dict field str)
  ;; credits gile gc:FieldCode
  (defun ObjIdxStr (fld / pos)
  (setq pos (vl-string-search "ObjIdx " (cdr (assoc 2 fldId)) 0))
  (substr fld (1+ pos) (- (vl-string-search ">%" fld pos) pos))
  )
  (defun foo (field str / pos fldID objID)
    (setq pos 0)
    (if (setq pos (vl-string-search "\\_FldIdx " str pos))
      (while (setq pos (vl-string-search "\\_FldIdx " str pos))
        (setq fldId (entget (cdr (assoc 360 field)))
              field (vl-remove (assoc 360 field) field))
        (setq
              str   (strcat
                      (substr str 1 pos)
                      (if (setq objID (cdr (assoc 331 fldId)))
                        (vl-string-subst
                          ;;; (strcat "ObjId " (itoa (gc:EnameToObjectId objID))) ;;; VVA 2015-12-07
                          (strcat "ObjId " (bg:GetObjectIDString objID))
                          ;;; "ObjIdx" ;;; rem VVA 2015-12-07
                          (ObjIdxStr (cdr (assoc 2 fldId))) ;;; add VVA 2015-12-07
                          (cdr (assoc 2 fldId))
                        )
                        (foo fldId (cdr (assoc 2 fldId)))
                      )
                      (substr str (1+ (vl-string-search ">%" str pos)))
                    )
        )
      )
      str
    )
  )
  (setq elst (entget ent))
  (if (vlax-property-available-p (vlax-ename->vla-object ent) 'Textstring)
    (cond ((= (cdr(assoc 0 elst)) "MULTILEADER")
           (setq str (cdr(assoc 304 elst)))
           )
          ((and ;;; MTEXT ATTRIB ADD VVA 2011-20-27
             (member (cdr(assoc 0 elst)) '("ATTRIB"))
             (member '(101 . "Embedded Object") elst)
             )
           (setq str (apply 'strcat (append (bg:massoc 3 elst)(bg:massoc 1 (member '(101 . "Embedded Object") elst)))))
           )
          
          ((member (cdr(assoc 0 elst)) '("TEXT" "MTEXT" "ATTRIB"))
           (setq str (apply 'strcat (append (bg:massoc 3 elst)(bg:massoc 1 elst))))
           )
          (t (setq str (vla-get-TextString (vlax-ename->vla-object ent))))
    )
    )
  (if (and
	(member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
	(setq xdict (cdr (assoc 360 elst)))
	(setq dict (dictsearch xdict "ACAD_FIELD"))
	(setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
      )
    (setq str (foo field (cdr (assoc 2 field))))
  )
    str
)
(defun bg:GetObjectIDString ( obj / *util* )
  (if (eq (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
    )
  (setq *util* (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object))))
  (if  (vlax-method-applicable-p *util* 'GetObjectIdString)
    (vla-GetObjectIdString *util* obj :vlax-false)
    (itoa (vla-get-ObjectId obj))
  )
 )
(defun bg:massoc (key alist)
  ;;;lib:massoc mip_lib.lsp
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))

(princ "\nType MTLE, MTLS, VLR_MTLE_ON, VLR_MTLE_OFF in command line")(princ)
;;;Если нужно активизировать реактор при загрузке уберите ;;; из последней строчки
;;;(C:VLR_MTLE_ON)

PS Старый вариант перенесен в пост #48
PPS Обновлено (теперь сохраняет поля в мтексте) см. http://forum.dwg.ru/showthread.php?p...56#post1480456
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 08.12.2015 в 19:02. Причина: Новая версия выбор только MULTILEADER
VVA вне форума  
 
Непрочитано 19.11.2010, 02:01
#52
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


VVA, работает!
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 19.11.2010, 08:00
#53
Astartes

Котло- и реакторостроение
 
Регистрация: 25.02.2010
Барнаул
Сообщений: 807


VVA, А можно сделать, чтобы при загрузке автокада рекатор автоматом включался. Т.е. сам реактор.лсп у меня в автозагрузке, но потом приходится набирать VLR_MTLE_ON.
Astartes вне форума  
 
Непрочитано 19.11.2010, 10:05
1 | #54
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Astartes, Или
1. В Автозагрузку вставь строчку после загрузки лиспа (C:VLR_MTLE_ON)
2. Вставь эту строчку в конец самого лисп файла
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 19.11.2010, 11:02
#55
Astartes

Котло- и реакторостроение
 
Регистрация: 25.02.2010
Барнаул
Сообщений: 807


VVA, Шикарно.
Спасибо.
Astartes вне форума  
 
Непрочитано 29.11.2010, 15:39
#56
Sokolov_Art


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


Так намного лучше!

Поработав несколько часов, нашёл неточность:

Я добавил строчку (C:VLR_MTLE_ON) в конец файла LISP и добавил файл в автозагрузку.
при каждом открытии нового чертежа *LE* прибавлялось в левом нижнем углу (см. рис) *LE**LE**LE**LE**LE* - 5 открытых файлов

Решил проблему добавлением в файл LISP-a строчки: (C:VLR_MTLE_OFF)
перед строчкой (C:VLR_MTLE_ON)

(setvar "MODEMACRO" (VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO")))
(princ "\nMtex Line Equal Reactor OFF")
(princ)
)
(princ "\nType MTLE, MTLS, VLR_MTLE_ON, VLR_MTLE_OFF in command line")
(C:VLR_MTLE_Off)
(C:VLR_MTLE_ON)


При каждом новом чертеже он выключает то что было до него и включает один раз... Наверняка можно как-то умнее.
Просто хотел обратить внимание.
Миниатюры
Нажмите на изображение для увеличения
Название: Снимок.JPG
Просмотров: 215
Размер:	41.8 Кб
ID:	49086  

Последний раз редактировалось Sokolov_Art, 29.11.2010 в 17:05.
Sokolov_Art вне форума  
 
Непрочитано 06.12.2010, 19:22
#57
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Sokolov_Art Посмотреть сообщение
Наверняка можно как-то умнее.
Просто хотел обратить внимание.
Спасибо Sokolov_Art, только сейчас заметил. Обновил #51. Должно работать. Изменения выделил синим.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 31.03.2011, 17:12
#58
Liam

Бумагомаратель
 
Регистрация: 02.11.2007
Пермь
Сообщений: 1,531


VVA, спасибо за полезный лисп.
А как можно применить эту команду ко всем уже существующим мультивыноскам в чертеже?
Liam вне форума  
 
Непрочитано 31.03.2011, 19:40
#59
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Liam Посмотреть сообщение
А как можно применить эту команду ко всем уже существующим мультивыноскам в чертеже?
Читать #51 команда MTLE значение коэффициента 0.86
Кстати, такие же проблемы и с китайским языком (требуетя регистрация). Код #51 так же помог.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 31.03.2011, 22:46
#60
Liam

Бумагомаратель
 
Регистрация: 02.11.2007
Пермь
Сообщений: 1,531


Цитата:
Сообщение от VVA Посмотреть сообщение
Читать #51 команда MTLE значение коэффициента 0.86
Кстати, такие же проблемы и с китайским языком (требуетя регистрация). Код #51 так же помог.
Это всё здорово, конечно, но если использовать значение 0.86, то вторая строка текста, которая под выносной линией пишется поднимается вверх и получается обратный эффект...
Кроме того, если вызвать команду MTLE и выбрать существующие выноски, то спец. символы в них (значки швеллера, треугольнички и т.п.) превращаются в "?" (использую mipgost). =(
Liam вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Требуется помощь,что бы Mleader не опускался

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Требуется восстановить ригель Куртан Конструкции зданий и сооружений 4 13.09.2008 12:05
Требуется ли дымоудаление irwave Прочее. Архитектура и строительство 1 18.03.2007 08:46