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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как имя VLA-OBJECT преобразовать в текстовую строку? А потом обратно, еще надо)

Как имя VLA-OBJECT преобразовать в текстовую строку? А потом обратно, еще надо)

Ответ
Поиск в этой теме
Непрочитано 10.07.2019, 11:24
Как имя VLA-OBJECT преобразовать в текстовую строку? А потом обратно, еще надо)
OKJI
 
AutoLISP
 
Харьков
Регистрация: 19.06.2018
Сообщений: 101

Здравствуйте дорогие друзья)
Записываю ряд глобальных переменных в реестр для того чтобы можно было их повторно использовать после перезагрузки автокада. Для записи в реестр использую строковые представления данных.
Вот преобразователь данных:
Код:
[Выделить все]
 
(SETQ vl_1(nth 0 li_tab_spe_th))
;; где li_tab_spe_th = (#<VLA-OBJECT IAcadTable 0000000046a6b0b8> #<VLA-OBJECT IAcadTable 0000000056229498>)
(SETQ vs_1 (IF (= 'str (TYPE vl_1)) (STRCAT "v_m_s" vl_1)
		         (IF (= 'nil (TYPE vl_1)) (STRCAT "v_m_n" "")
			 (IF (= 'REAL (TYPE vl_1)) (STRCAT "v_m_r" (RTOS vl_1))
			   (IF (= 'INT (TYPE vl_1)) (STRCAT "v_m_i" (RTOS vl_1))
			     (IF (= 'VLA-OBJECT (TYPE vl_1)) (STRCAT "v_m_j"  (КАКАЯ-ТО_ФУНКЦИЯ vl_1))
			     ""
      ))))))
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\autoLisP_sav\\" vs_ind_reg vs_1)
Данные типа:
- строка
- целое число
- вещественное число
- nil
получилось преобразовать в строку

Код:
[Выделить все]
 
;;  Набор функций для записи и считывания с РЕЕСТРА ======================================================

;||

Пример работы с списком:

(setq vs_nam_li "we38")
(set (read vs_nam_li) (list nil 658.001 87651836 "аврывор 131"))

(sk_dat->regist vs_nam_li)
(sk_regist->dat vs_nam_li)

Пример работы с АТОМОМ:

(setq vs_nam_li "we38")
(set (read vs_nam_li) "раз 787")

(sk_dat->regist vs_nam_li)
(sk_regist->dat vs_nam_li)
;|
|;

(DEFUN v_l>s (vl_in / vl_1)
  (IF (< 0 (STRLEN vs_1))
    (IF (= (STRLEN (VL-STRING-RIGHT-TRIM "v_ls(" vs_1)) (STRLEN vs_1))
      (SETQ vs_1 (STRCAT vs_1 " v_ls("))
      (SETQ vs_1 (STRCAT vs_1 "v_ls("))
    )
    (SETQ vs_1 (STRCAT vs_1 "v_ls("))
  )
  (WHILE (AND (/= vl_in nil) (LISTP vl_in))
    (SETQ vl_1 (CAR vl_in))
    (IF	(ATOM vl_1)
      (PROGN
        (SETQ vs_1 (STRCAT vs_1 (if (= (strlen (VL-STRING-RIGHT-TRIM  "v_ls(" vs_1)) (strlen vs_1)) " " "")
		       (IF (= 'str (TYPE vl_1)) (STRCAT "v_m_s" vl_1)
		         (IF (= 'nil (TYPE vl_1)) (STRCAT "v_m_n" "")
			 (IF (= 'REAL (TYPE vl_1)) (STRCAT "v_m_r" (RTOS vl_1))
			   (IF (= 'INT (TYPE vl_1)) (STRCAT "v_m_i" (RTOS vl_1))
			     (IF (= 'VLA-OBJECT (TYPE vl_1)) (STRCAT "v_m_j" (vlax-get-property vl_1 'Handle))
			     ""
      ))))))))
      (PROGN	
        (SETQ vs_1 (v_l>s vl_1))
        )
      )
    (SETQ vl_in (CDR vl_in))
    (if (= vl_in nil) (SETQ vs_1 (STRCAT vs_1 ")v_le")))
  )
  vs_1
)


(DEFUN sk_dat->regist (vs_nam_li)
  (SETQ vl_in (EVAL (READ vs_nam_li)))
  (SETQ vs_ind_reg (STRCASE vs_nam_li))
  (SETQ vs_1 "")
  (IF (and (LISTP vl_in)vl_in)
    (VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\autoLisP_sav\\" vs_ind_reg (v_l>s vl_in))
    (PROGN
      (setq vl_1 vl_in)
      (IF	(ATOM vl_1)
        (PROGN
	(SETQ vs_1 (STRCAT "" (IF (= 'str (TYPE vl_1)) (STRCAT "v_m_s" vl_1)
			    (IF (= 'nil (TYPE vl_1)) (STRCAT "v_m_n" "")
			      (IF (= 'REAL (TYPE vl_1)) (STRCAT "v_m_r" (RTOS vl_1))
			        (IF (= 'INT (TYPE vl_1)) (STRCAT "v_m_i" (RTOS vl_1))
				(IF (= 'VLA-OBJECT (TYPE vl_1)) (STRCAT "v_m_j" (vlax-get-property vl_1 'Handle))
			     ""
      ))))))))
      (PROGN	
        (SETQ vs_1 (v_l>s vl_1))
        )
      )
      (VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\autoLisP_sav\\" vs_ind_reg vs_1)
    )
  )
)

(DEFUN v_lf>lr (vs_in / vs_1 vl_s vl_in_reg)
  (SETQ vs_in (VL-STRING-LEFT-TRIM " " vs_in))
  (IF (/= "" (STRLEN (VL-STRING-LEFT-TRIM " " vs_in)))
    (PROGN
      (WHILE (< 4 (STRLEN vs_in))
        (SETQ v_sir "v_ls(")
        (SETQ v_poz (VL-STRING-SEARCH v_sir (VL-STRING-LEFT-TRIM " " vs_in)))
        (IF (= 0 v_poz)
	(PROGN ;_ rekursia
	  (SETQ vl_s (vs_cut_kod vs_in))
	  (SETQ vs_1 (NTH 0 vl_s))
	  (SETQ vl_in_reg (APPEND vl_in_reg (LIST (v_lf>lr vs_1))))
	  (SETQ vs_in (NTH 1 vl_s))
	)
	(IF (/= 0 (STRLEN (VL-STRING-LEFT-TRIM " " (VL-STRING-RIGHT-TRIM " " vs_in))))
	  (PROGN
	    (SETQ vl_12 (vs_str->elem vs_in))
	    (SETQ vl_in_reg (APPEND vl_in_reg (LIST (NTH 0 vl_12))))
	    (SETQ vs_in (NTH 1 vl_12))
	  )
	  (setq vs_in "")
	)
        )
      )
      vl_in_reg
    )
  )
)



;; Создание списка (ЭЛЕМЕНТ:остаток кода:входной код)

(DEFUN vs_str->elem	(vs_in)
  (PROGN ;_ перебор списка
    (SETQ	v_i 0
	vl_poz nil
	vl_poz+cod nil
    )
    (WHILE (< v_i (LENGTH v_bas_reg))
      (SETQ v_11 (NTH v_i v_bas_reg))
      (SETQ v_poz1 (VL-STRING-SEARCH v_11 vs_in))
      (IF	v_poz1
        (SETQ vl_poz     (APPEND vl_poz (LIST v_poz1))
	    vl_poz+cod (APPEND vl_poz+cod (LIST (LIST v_poz1 v_11)))
        )
      )
      (SETQ v_i (+ v_i 1))
    )
    (IF (SETQ v_poz1 (NTH 0 (VL-SORT vl_poz '<)))
      (SETQ v_sir (NTH 1 (ASSOC v_poz1 vl_poz+cod)))
    )


    (SETQ vs_1 (SUBSTR vs_in (+ v_poz1 (STRLEN v_sir) 1) (STRLEN vs_in))) ;_ Часть строки в которой ищется текст
    (SETQ v_poz (VL-STRING-SEARCH v_sir vs_1))

    (SETQ	v_i 0
	vl_poz nil
	vl_poz+cod nil
    )
    (WHILE (< v_i (LENGTH v_bas_reg))
      (SETQ v_11 (NTH v_i v_bas_reg))
      (SETQ v_poz2 (VL-STRING-SEARCH v_11 vs_1))
      (IF	v_poz2
        (SETQ vl_poz     (APPEND vl_poz (LIST v_poz2))
	    vl_poz+cod (APPEND vl_poz+cod (LIST (LIST v_poz2 v_11)))
        )
      )
      (SETQ v_i (+ v_i 1))
    )
    (IF vl_poz
      (IF	(SETQ v_poz2 (NTH 0 (VL-SORT vl_poz '<)))
        (SETQ v_sir1 (NTH 1 (ASSOC v_poz2 vl_poz+cod)))
      )
    )


    (IF vl_poz
      (SETQ vs_txt (VL-STRING-RIGHT-TRIM " " (SUBSTR vs_in (+ v_poz1 (STRLEN v_sir) 1) (- v_poz2 0))))
      (SETQ vs_txt (VL-STRING-RIGHT-TRIM " " (SUBSTR vs_in (+ v_poz1 (STRLEN v_sir) 1))))
    )
    (IF (ATOM (SETQ vl_1 vs_txt))
      (SETQ v_1
	   (IF (= "v_m_s" v_sir) ;_ String
	     vl_1
	     (IF (= v_sir "v_m_n") ;_ Nom
	       nil
	       (IF (= v_sir "v_m_r") ;_ REAL
	         (ATOF vl_1)
	         (IF (= v_sir "v_m_i") ;_ INT
		 (ATOI vl_1)
		 (IF (= v_sir "v_m_j") ;_ OBJ=====================================
		   (VL-CATCH-ALL-APPLY
		       '(LAMBDA (x) (VLA-HANDLETOOBJECT doc vl_1))
		       (LIST vl_1))
		   (IF (= v_sir "v_ls(") ;_ LIST
		     (PROGN ;_ rekursia
		       (SETQ vl_s (vs_cut_kod vs_in))
		       (SETQ vs_1 (NTH 0 vl_s))
		       (SETQ vl_in_reg (APPEND vl_in_reg (LIST (v_lf>lr vs_1))))
		       (SETQ vs_in (NTH 1 vl_s))
		     )
		     (PROGN)))))))))
    (IF (VL-CATCH-ALL-ERROR-P v_1)
      (PROGN
        (ALERT (STRCAT "\nОбъект под кодом: \"" (VL-PRINC-TO-STRING vl_1) "\" - не найден"))
        nil
      )
      v_1
    )
    (IF v_poz2
      (SETQ vs_1 (SUBSTR vs_in (+ v_poz1 (STRLEN v_sir) v_poz2 1) (STRLEN vs_in)))
      (SETQ vs_1 "")
    )
    ;;(exit)
  )
  (List v_1 vs_1 vs_in)
)

(DEFUN vs_cut_kod (vs_in / v_i)
  (SETQ vl_bas_st_end (LIST "v_ls(" ")v_le"))


  ;; Sirch Open
  (SETQ v_sir (nth 0 vl_bas_st_end)
        v_k T
        v_poz 0
        v_poz_m 0
        v_k1 t
        vl_st nil
        vl_st+sir nil
  )
  (WHILE v_k
    (SETQ v_poz (VL-STRING-SEARCH v_sir (substr vs_in (+ v_poz_m 1))))
    (IF v_poz
      (SETQ vl_st	  (APPEND vl_st (LIST (+ v_poz v_poz_m)))
	  vl_st+sir (APPEND vl_st+sir (LIST (LIST (+ v_poz v_poz_m) v_sir))))
      (SETQ v_k nil))
    
    (IF v_k
      (IF	v_k1
        (SETQ v_poz_m (+ v_poz (STRLEN v_sir))
	    v_k1	  nil)
        (SETQ v_poz_m (+ v_poz_m v_poz (STRLEN v_sir)))))
  )
;||
((0 "v_ls(") (26 "v_ls(") (52 "v_ls("))
;|
|;


  ;; sirch Closed 
  (SETQ v_sir (nth 1 vl_bas_st_end)
        v_k T
        v_poz 0
        v_poz_m 0
        v_k1 t
        vl_end nil
        vl_end+sir nil
  )
  (WHILE v_k
    (SETQ v_poz (VL-STRING-SEARCH v_sir (substr vs_in (+ v_poz_m 1))))
    (IF v_poz
      (SETQ vl_end	  (APPEND vl_end (LIST (+ v_poz v_poz_m)))
	  vl_end+sir (APPEND vl_end+sir (LIST (LIST (+ v_poz v_poz_m) v_sir))))
      (SETQ v_k nil))
    
    (IF v_k
      (IF	v_k1
        (SETQ v_poz_m (+ v_poz (STRLEN v_sir))
	    v_k1	  nil)
        (SETQ v_poz_m (+ v_poz_m v_poz (STRLEN v_sir)))))
  )
;||
((76 ")v_le") (101 ")v_le") (125 ")v_le") (150 ")v_le"))
;|
|;
  (setq vl_poz (APPEND vl_st vl_end))
  (setq vl_poz+sir (APPEND vl_st+sir vl_end+sir))
  (setq vl_poz (vl-sort vl_poz '<))
  (SETQ v_i 0
        v_sum 0
  )
  (WHILE (< v_i (LENGTH vl_poz))
    (setq v_poz (nth v_i vl_poz))
    (setq v_sir (nth 1 (ASSOC v_poz vl_poz+sir)))
    (IF (= v_sir "v_ls(")
      (SETQ v_sum (+ v_sum 1))
      (SETQ v_sum (- v_sum 1))
    )
    (IF (= v_sum 0)
      (SETQ v_i (LENGTH vl_poz))
    )
    (SETQ v_i (+ v_i 1))
  )
  (SETQ v_poz_s (NTH 0 vl_poz)
        v_poz_e v_poz
  )
  (IF (<= 0 (- v_poz_e v_poz_s (STRLEN v_sir)))
    (SETQ	vs_cat (SUBSTR vs_in (+ v_poz_s (STRLEN v_sir) 1) (- v_poz_e v_poz_s (STRLEN v_sir)))
	vs_joi (STRCAT (SUBSTR vs_in 1 (+ v_poz_s 0)) (SUBSTR vs_in (+ v_poz_e (STRLEN v_sir) 1)))
    )
    (SETQ	vs_cat ""
	vs_joi vs_in
    ))
  (list (STRCAT vs_cat "" ) (STRCAT vs_joi "" ))
)

(DEFUN vs_katom->ratom (vs_txt)
  (if (= 'str (type vs_txt))
    (IF (ATOM (SETQ vl_1 vs_txt))
    (SETQ	v_1
	 (IF (setq v_poz (VL-STRING-SEARCH (setq v_sir "v_m_s") vl_1)) ;_ String
	   (SUBSTR vl_1 (+ v_poz (STRLEN v_sir) 1) )
	   (IF (VL-STRING-SEARCH  "v_m_n" vl_1) ;_ Nom
	     nil
	     (IF (setq v_poz (VL-STRING-SEARCH (setq v_sir "v_m_r") vl_1)) ;_ REAL
	       (ATOF (SUBSTR vl_1 (+ v_poz (STRLEN v_sir) 1) ))
	       (IF (setq v_poz (VL-STRING-SEARCH (setq v_sir "v_m_i") vl_1)) ;_ INT
	         (ATOI (SUBSTR vl_1 (+ v_poz (STRLEN v_sir) 1) ))
	         (IF (setq v_poz (VL-STRING-SEARCH (setq v_sir "v_m_j") vl_1)) ;_ INT
		 (VL-CATCH-ALL-APPLY
		       '(LAMBDA (x) (VLA-HANDLETOOBJECT doc (SUBSTR x (+ v_poz (STRLEN v_sir) 1))))
		       (LIST vl_1))
		 (PROGN))))))))(setq v_1 nil))
  (IF (VL-CATCH-ALL-ERROR-P v_1)
    (PROGN
      (ALERT (STRCAT "\nОбъект под кодом: \"" (VL-PRINC-TO-STRING vl_1) "\" - не найден"))
      nil)
    v_1)
)


(DEFUN sk_regist->dat (vs_nam_li)
  (SETQ vs_ind_reg (STRCASE vs_nam_li))

  (setq acadObj (vlax-get-acad-object))
  (setq doc (vla-get-ActiveDocument acadObj))
  (SETQ v_bas_reg (LIST "v_ls(" "v_m_s" "v_m_n" "v_m_r" "v_m_i" "v_m_j" ")v_le"))
  (SETQ v_bas_reg1 (LIST "v_ls(" ")v_le"))

  (SETQ vs_in (VL-REGISTRY-READ "HKEY_CURRENT_USER\\autoLisP_sav\\" vs_ind_reg))
  (IF (= 'str (TYPE vs_in))
    (IF (VL-STRING-SEARCH "v_ls(" vs_in)
      (nth 0 (v_lf>lr vs_in))
      (vs_katom->ratom vs_in)
    )
    (vs_katom->ratom vs_in)
  )
)
__________________
Вечность это:
 (while T)

Последний раз редактировалось OKJI, 20.08.2019 в 14:06.
Просмотров: 3617
 
Непрочитано 11.07.2019, 11:09
#21
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


заархивировать и приложить архив
koMon вне форума  
 
Непрочитано 11.07.2019, 11:13
#22
trir


 
Регистрация: 18.12.2010
Сообщений: 5,047


Цитата:
Как построить вот такую схему с помощью БД?
кучей разных способов
в БД умудрились запихать карту мира - с твоей схемой точно справятся

Последний раз редактировалось trir, 11.07.2019 в 11:24.
trir вне форума  
 
Непрочитано 11.07.2019, 11:32
#23
Vov.Ka


 
Регистрация: 21.07.2008
Луцьк
Сообщений: 179


Цитата:
Сообщение от OKJI Посмотреть сообщение
Не учил я в школе расширенные данные и словарные записи)))
для твоих целей достаточно функций vlax-ldata-*
Vov.Ka вне форума  
 
Непрочитано 11.07.2019, 12:27
1 | 1 #24
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от OKJI Посмотреть сообщение
Как построить вот такую схему с помощью БД?
Построить? БД не строит, она (точнее система управления БД - СУБД) хранит, и обрабатывает информацию перед выдачей)

Например, SQL представляет собой таблицы (как визуальные таблицы в акаде, только гораздо более удобнее-). При этом каждая строка строка таблицы однозначно определяется ключом ID. Простейший пример:

Есть таблица данных спецификации:
Цитата:
Таблица данные_спецификации
----------------------------------
ID строки таблицы
Имя_продукта
Тип_продукта
Код_продукта
и дальше те поля, что фигурируют в спецификации
Есть таблица списка примитивов:

Цитата:
Список_примитивов
----------------------------------
ID строки таблицы
Хэндл примитива
ID внешнего ключа, ссылающийся на строки таблицы данных спецификации
Каждый примитив, участвующий в организации информационной модели (молчать про BIM -), заносится в данную таблицу. А в XData примитива заносится ID строки таблицы. Соответственно, надо через события отслеживать удаление/восстановление примитивов для поддержки актуальности таблицы. И кликнув по любому объекту, можно получить из его XData ID строки таблицы, потом - сделав запрос в БД по ID внешнего ключа - информацию из таблицы данных спецификации.


Теперь описываем соединение кабеля на плане:

Цитата:
Таблица_соединений_кабелей
----------------------------------
ID кабеля = ID строки таблицы "Список примитивов"
ID примитива, откуда идет
ID примитива, куда идет
Номер кабеля
И вводим таблицу связей с выносками
Цитата:
Связь с выносками
-----------------------
ID примитива
ID выноски
Вид вывода информации (перечисление - только номер кабеля, или еще и тип кабеля, например)
Выглядит сложновато, но что это дает: физическая связь с элементами чертежа на уровне таблицы "Список примитивов", вся остальная логика работает уже вне чертежа. Можно заменять любой примитив, предварительно сохранив его ID из XData и потом обновив запросом хэндл в таблице "Список_примитивов" - и все связи логические останутся. Метод обновления выноски (привязанной к кабелю) унифицирован, туда передается ID примитива - а остальное метод подгребет сам из БД соответствующим запросом (в завимости от значения "Вид вывода информации"). И т.д. А заодно таблица "Список_примитивов" поможет восстановить XData в чертеже, если "продвинутый" пользователь во время чистки чертежа или рукожопый "программист" очередной надстройки их снесет)

Ну это изначально надо было формировать БД в программе, а не когда уже написана куча кода)
Сергей812 вне форума  
 
Непрочитано 11.07.2019, 17:45
#25
VVA

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


Цитата:
Сообщение от Vov.Ka Посмотреть сообщение
Не учил я в школе расширенные данные и словарные записи)))
Хранение пользовательских типов данных. Часть 3.2. ini-файлы.
А так же посмотри описание функций лиспа setcgf и getcfg

Код:
[Выделить все]
(setcfg "AppData/autoLisP_sav/VARNAME1" "VARNAME1_VALUE")
(getcfg "AppData/autoLisP_sav/VARNAME1")
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 11.07.2019, 18:06
#26
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от VVA Посмотреть сообщение
А так же посмотри описание функций лиспа setcgf и getcfg
тыц

Цитата:
Note: getcfg and setcfg are still available for compatibility, but might be removed in a future release. It is recommended to use the vl-registry-read and vl-registry-write functions as replacements.
Круг замкнулся)
Сергей812 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как имя VLA-OBJECT преобразовать в текстовую строку? А потом обратно, еще надо)

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как построить среднюю линию между непараллельными? vigold AutoCAD 53 10.03.2023 23:13
На какие нормативные документы надо опереться при осуществлении перехода с 4х полосной дороги в 2х полосный мост и обратно. ИванГрозный Автомобильные и железные дороги, мосты, тоннели и организация движения 0 05.04.2017 11:55
Участок обезвреживания медицинских и биологических отходов надо ли там делать пожарную сигнализацию или надо спринклерную систему пожаротушения Виктор31 Прочее. Отраслевые разделы 1 01.07.2016 10:21
Надо ли считать на прогиб от собственного веса Миксер Металлические конструкции 10 18.09.2015 15:48
Размеры в текстовую строку flashground AutoCAD 6 25.03.2012 18:47