Schöck
Показать сообщение отдельно
Непрочитано 10.07.2019, 11:24 #1
Как имя 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.
Просмотров: 1366
 
Размещение рекламы