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

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

Преобразование текста в мультивыноску с сохранением поля.

Ответ
Поиск в этой теме
Непрочитано 27.01.2015, 15:48 #1
Преобразование текста в мультивыноску с сохранением поля.
shartal
 
Регистрация: 12.08.2009
Сообщений: 447

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

Код:
[Выделить все]
 (defun c:mt2ml ( / oobj nobj nstrg)
  (vl-load-com)
  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)	   
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)	   
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)
Просмотров: 14944
 
Непрочитано 27.01.2015, 16:46
#2
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Можно, и очень просто:
Код:
[Выделить все]
 (defun c:mt2ml ( / oobj nobj nstrg)
  (vl-load-com)
  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (setq nstrg (vla-FIELDCODE oobj))
    (exit)	   
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)	   
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)
kp+ вне форума  
 
Автор темы   Непрочитано 27.01.2015, 17:46
#3
shartal


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


Поле в выноску вставляется, но связь с объектом потеряна, решетки однако
shartal вне форума  
 
Непрочитано 27.01.2015, 18:38
1 | #4
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Надо принудительно обновить поле любым удобным способом (_updatefield, _regen), и все будет путем.
kp+ вне форума  
 
Автор темы   Непрочитано 02.02.2015, 14:42
#5
shartal


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


Беда происходит. Вставленные в текст символы (метр квадратный и др.) превращаются в вопросы. Шрифт mipgost
shartal вне форума  
 
Непрочитано 02.02.2015, 16:11
#6
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от shartal Посмотреть сообщение
Беда происходит. Вставленные в текст символы (метр квадратный и др.) превращаются в вопросы. Шрифт mipgost
А какое это имеет отношение к начальному вопросу?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 02.02.2015, 17:09
#7
shartal


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


?
Самое прямое. Символы текста, преобразуемого в мультивыноску превращаются в вопросы.
shartal вне форума  
 
Непрочитано 02.02.2015, 17:40
#8
Кулик Алексей aka kpblc
Moderator

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


Не лечится. Строка в lisp, насколько я понимаю, с трудом поддерживает подобное форматирование.
---
Добавлено:
Я гонял такой код:
Код:
[Выделить все]
 (defun tt (/ ent pt_lst anno mleader adoc)
  (if
    (and (= (type (setq ent (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (vlax-ename->vla-object (car (entsel "\nSelect text <Cancel> : ")))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'vla-object
            ) ;_ end of =
         (vlax-property-available-p ent 'textstring)
         (= (type (setq pt_lst (vl-catch-all-apply
                                 (function
                                   (lambda (/ pt)
                                     (setq pt (list (setq pt (getpoint "\nSelect point for mleader <Cancel> : "))
                                                    (getpoint pt "\nSelect second point for mleader <Cancel> : ")
                                                    ) ;_ end of list
                                           ) ;_ end of setq
                                     (mapcar
                                       (function
                                         (lambda (x)
                                           (list (car x)
                                                 (cadr x)
                                                 (cond
                                                   ((caddr x))
                                                   (t 0.)
                                                   ) ;_ end of cond
                                                 ) ;_ end of list
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       pt
                                       ) ;_ end of mapcar
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'list
            ) ;_ end of =
         ) ;_ end of and
     (progn
       (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
       (setq pt_lst  (apply (function append)
                            (mapcar (function (lambda (x)
                                                (list (car x)
                                                      (cadr x)
                                                      (cond ((caddr x))
                                                            (t 0.)
                                                            ) ;_ end of cond
                                                      ) ;_ end of list
                                                ) ;_ end of lambda
                                              ) ;_ end of function
                                    pt_lst
                                    ) ;_ end of mapcar
                            ) ;_ end of apply
             mleader (vla-addmleader (vla-get-modelspace adoc)
                                     (vlax-make-variant
                                       (vlax-safearray-fill
                                         (vlax-make-safearray
                                           vlax-vbdouble
                                           (cons 0 (1- (length pt_lst)))
                                           ) ;_ end of vlax-make-safearray
                                         pt_lst
                                         ) ;_ end of vlax-safearray-fill
                                       ) ;_ end of vlax-make-variant
                                     0
                                     ) ;_ end of vla-AddMLeader
             ) ;_ end of setq
       (vla-put-contenttype mleader 2)
       (vla-put-textstring mleader
                           (if (vlax-method-applicable-p ent 'fieldcode)
                             (vla-fieldcode ent)
                             (vla-get-textstring ent)
                             ) ;_ end of if
                           ) ;_ end of vla-put-TextString
       (vla-erase ent)
       (vla-regen adoc acactiveviewport)
       (vla-endundomark adoc)
       ) ;_ end of progn
     ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 02.02.2015 в 17:48.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 02.02.2015, 17:44
#9
shartal


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


В этом коде создается поле на другой текст/поле и в мультивыноску тоже. Символы сохраняются. Насколько я понимаю, задача похожая.
Код:
[Выделить все]
  (defun c:fc (/ ename_get t_str ID obj)
  ;;; Copy field
  (vl-load-com)
  (and
    (setq obj (car (nentsel "\nоткуда брать содержимое")))
    (setq obj (vlax-ename->vla-object obj))
    (setq ID (vla-get-objectid obj ))
    (if (vlax-property-available-p obj 'Textstring)
      (progn
        (setq ename_get (entget (car (nentsel "\nкуда писать"))))
        (setq	t_str (strcat
			
			"%<\\AcObjProp Object(%<\\_ObjId "
		      (itoa ID)
		      ">%).TextString>%"
	      )
                )
          (vla-put-TextString (vlax-ename->vla-object (cdr(assoc -1 ename_get))) t_str)
          (entupd (cdr (assoc -1 ename_get)))
          (command "_updatefield" (cdr (assoc -1 ename_get)) "" "_regenall")
        )
      (alert "У объекта нет свойства\n   Textsring")
      )
    )
  (princ)
);defun
----- добавлено через ~3 мин. -----
В твоем коде та же фигня. Символы в вопросы превращаются.
shartal вне форума  
 
Непрочитано 02.02.2015, 17:48
#10
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от shartal Посмотреть сообщение
Насколько я понимаю, задача похожая.
По-моему, не совсем.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 02.12.2015, 16:29
#11
dima_25


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


Добрый день. В продолжение темы преобразования в мультивыноску. Зачастую встречаются выноски, в которых выносная линия и полка выполнены с помощью отрезков или полилиний, а содержимое с помощью текста (TXT или MTXT). То есть уже определено положение полки и привязка выносной линии. Есть ли возможность эти объекты трансформировать (может быть одновременно все на чертеже) в мультивыноски? Спасибо.
dima_25 вне форума  
 
Непрочитано 02.12.2015, 17:06
1 | #12
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Попробуй этот код. Только стиль текста и стиль мультивыноски надо заранее создать.
Код:
[Выделить все]
(defun C:TXT-MLD ( / echo obj1 obj2 obj3 строка1 строка2 строка3)
(vl-cmdf "_UNDO" "_BE")
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq obj1 (car (entsel "\nВыберите текст 1: ")))
(if obj1
    (progn
    (setq строка1 (vlax-get-property (vlax-ename->vla-object obj1) 'TextString))
    (setq obj2 (car (entsel "\nВыберите текст 2 (Enter-конец): ")))
    (setq obj3 (car (entsel "\nВыберите текст 3 (Enter-конец): ")))
    (if obj2 
        (setq строка2 (vlax-get-property (vlax-ename->vla-object obj2) 'TextString))
    ) ; if
    (if obj3 
        (setq строка3 (vlax-get-property (vlax-ename->vla-object obj3) 'TextString))
    ) ; if
       (cond
       ((and obj1 (= obj2 nil) (= obj3 nil))
         (princ "\n Построение мультивыноски: укажите 1-ю и 2-ю точки.")
         (vl-cmdf "_mleader" pause pause строка1)
         (vl-cmdf "_ERASE" obj1 "")
       ) ; cond1
       ((and obj1 obj2 (= obj3 nil))
         (princ "\n Построение мультивыноски: укажите 1-ю и 2-ю точки.")
         (vl-cmdf "_mleader" pause pause (strcat строка1 "\n" строка2))
         (vl-cmdf "_ERASE" obj1 obj2 "")
       ) ; cond2
       ((and obj1 obj3 (= obj2 nil))
         (princ "\n Построение мультивыноски: укажите 1-ю и 2-ю точки.")
         (vl-cmdf "_mleader" pause pause (strcat строка1 "\n" строка3))
         (vl-cmdf "_ERASE" obj1 obj3 "")
       ) ; cond3
       ((and obj1 obj3 obj2)
         (princ "\n Построение мультивыноски: укажите 1-ю и 2-ю точки.")
         (vl-cmdf "_mleader" pause pause (strcat строка1 "\n" строка2 "\n" строка3))
         (vl-cmdf "_ERASE" obj1 obj2 obj3 "")
       ) ; cond4
       ) ; cond
    ) ; progn
    (princ "\nНе выбрана строка 1.")
) ; if 
(setvar "CMDECHO" 0)
(vl-cmdf "_UNDO" "_E")
(princ)
)
Profan вне форума  
 
Непрочитано 03.12.2015, 11:40
#13
dima_25


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


Большое спасибо за отклик!
Но к сожалению, этот код сделал только из 3-х разных однострочных текстов одну мультивыноску. Это полезный код, но не то, что хотелось. Может быть, я неправильно понял как он работает. Может, неправильно объяснил. В качестве примера прикрепляю план. Там есть мультивыноски, но есть и полилинии с текстом, которые хотелось бы автоматически объединить в мультивыноску.
ПО Windows7, autocad2014
Вложения
Тип файла: dwg
DWG 2007
в мультивыноски.dwg (634.6 Кб, 1006 просмотров)
dima_25 вне форума  
 
Непрочитано 03.12.2015, 12:00
#14
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Во-первых, не только из 3-х, но и из 2-х, и из 1-ой, и из МТекст. Во-вторых - это просто пример, выдранный из более сложной программы. Как я понимаю, вам хотелось бы автоматом всю эту кучу отрезков, полилиний, текстов одним махом превратить в мультивыноски. За такую задачу я не возьмусь.
Profan вне форума  
 
Непрочитано 03.12.2015, 13:09
#15
dima_25


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


Понял! Спасибо
dima_25 вне форума  
 
Непрочитано 03.12.2015, 19:01
#16
VVA

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


Цитата:
Сообщение от shartal Посмотреть сообщение
Беда происходит. Вставленные в текст символы (метр квадратный и др.) превращаются в вопросы. Шрифт mipgost
Только сейчас наткнулся на этот вопрос. Лучше поздно чем никогда. Проблема известная. И vla-get-TextString и vla-FIELDCODE неверно возвращают строку, если в ней есть unicod символы. Выход - ковырять dxf группы.
Вариант кода из #2
Код:
[Выделить все]
 
  (defun c:mt2ml ( / oobj nobj nstrg pt1 pt2)
  (vl-load-com)
  (setq oobj (car (nentsel "\nSelect source text: ")))
  (setq nstrg (bg:FieldCode oobj)
         oobj (vlax-ename->vla-object oobj)
        )
   (initget 1)
   (setq pt1 (getpoint "\nSpecify leader arrowhead location :"))
   (initget 1)
   (setq pt2 (getpoint pt1 "\nSpecify leader landing location :"))
   (if command-s
     (command-s "_MLEADER" "_o" "_m" 2 "_x" "_h" "_none" pt1 "_none" pt2 "test" "")
     (command "_MLEADER" "_o" "_m" 2 "_x" "_h" "_none" pt1 "_none" pt2 "test" "")
     )
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (progn
      (vlax-put-property nobj 'TextString nstrg)
      (vl-cmdf "_updatefield" "_all" "" "_regenall")
      )
    (exit)	   
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)
(defun bg:FieldCode (ent / foo elst xdict dict field str tmp)
  ;;;VVA 2018-11-17
  ;; 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 ent (bg:conv-ent-to-ename ent)) 
  (setq elst (entget ent))
  (if (vlax-property-available-p (vlax-ename->vla-object ent) 'Textstring)
    (cond ((= (cdr(assoc 0 elst)) "MULTILEADER")
           (setq str (bg:conv-to-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 (bg:conv-to-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 tmp str)
      )
    (if (VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY '(lambda ()(setq str (foo field (cdr (assoc 2 field)))))))
      (setq str tmp)
      )
  )
    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)))
(defun bg:conv-ent-to-ename (ent / ret)
;;;    Выполняет преобразование переданного указателя в ename-вариант
;;;    Параметры вызова:
;;;	ent	обрабатываемый указатель. Может быть:
;;;		 ename
;;;		 vla-object
;;;		 строка (воспринимается как хендл примитива)
;;;		 список, полученный от (entsel)
;;;		 список, полученный от (entget)

  (cond
    ((= (type ent) 'vla-object) (vlax-vla-object->ename ent))
    ((= (type ent) 'ename) ent)
    ((= (type ent) 'str) (handent ent))
;;; VVA 26/12/2007 : start
    ((and (= (type ent) 'list)
          (= (type (setq ret (car ent))) 'ename)
          ) ;_ end of and
     ret
     )
    ((= (type ent) 'list) (cdr (assoc -1 ent)))
    (t nil)
;;; VVA 26/12/2007 : end
    ) ;_ end of cond
  )
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 07.02.2022 в 23:02. Причина: обновлена ф-ция bg:fieldcode https://forum.dwg.ru/showpost.php?p=1980116&postcount=616
VVA вне форума  
 
Автор темы   Непрочитано 04.12.2015, 11:03
#17
shartal


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


Что- то идет не так. Во первых там требуется bg:massoc. Я предварительно загрузил bgtools. Там есть эта функция. Но после применения команды, поле становится решетками и уже не обновляется.
shartal вне форума  
 
Непрочитано 04.12.2015, 15:33
#18
VVA

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


bg:massoc добавил
shartal, Выложи пример в dwg
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 04.12.2015, 15:43
#19
shartal


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


Вот
Вложения
Тип файла: dwg
DWG 2010
прим.dwg (333.2 Кб, 814 просмотров)
shartal вне форума  
 
Непрочитано 05.12.2015, 20:43
#20
VVA

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


Обновил #16
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Преобразование текста в мультивыноску с сохранением поля.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 272 06.06.2021 23:12
Преобразование многострочного текста в блок с атрибутами superkot007 Программирование 16 21.03.2014 15:26
Программное создание размерных стилей Кулик Алексей aka kpblc Программирование 89 08.04.2013 12:59
LISP. Выравнивание текста по двум точкам. Krieger Готовые программы 10 24.12.2011 16:02
Подскажите компонент поля ввода текста (для VBA) kp+ Программирование 7 09.02.2010 22:03