
下段に文字を追加するAutoLISPコマンドです。
上段の寸法にはWを付加、下段の数字にはHが付加されます。


(defun c:SD_1202( / ObjSet ObjNameL i m OldData NewData Data
dcl_id UserWord)
(if (= SD:Lang "E")
(princ "\n [SD_1202 ver.20220902] Add Text below dimension line. Press [F1] for help")
(princ "\n [SD_1202 ver.20220902] 寸法の下にHを併記。 [F1]で使い方説明")
)
(princ "\n **********************************")
(load "SD_U")
(setq *error* *myerror*)
(OpeningRoutine)
(setfunhelp "C:SD_1202" "https://www.offshorecad.com.ph/speeddraft/blog/sd_1202/")
(RegistryRead_1202) ;レジストリからデータを取得
(Show_Dialog_1202)
(setq ObjSet nil)
(while (= ObjSet nil)
(setq ObjSet (ssget '((0 . "DIMENSION"))))
)
;選択セットから図形名のリスト作成
(setq i -1 ObjNameL nil)
(repeat (setq m (sslength ObjSet))
(setq ObjNameL (append ObjNameL (list (ssname ObjSet (setq i (1+ i))))))
)
(procedure_1202)
(ClosingRoutine)
(setq *error* nil)
(princ)
)
;********************************
(defun procedure_1202()
(mapcar '(lambda(x)
(setq OldData (cdr (assoc 1 (setq Data (entget x)))))
(setq NewData (strcat "W<>\\XH" UserWord ))
(setq Data (subst (cons 1 NewData)(assoc 1 Data) Data))
(entmod Data)
) ObjNameL
)
)
;********************************
(defun Show_Dialog_1202()
(setq dcl_id (load_dialog "SD_1202.dcl"))
(if (= SD:Lang "E")
(new_dialog "SD_1202" dcl_id)
(new_dialog "SD_1202_J" dcl_id)
)
(set_tile "Text1" UserWord)
(action_tile "accept" "(get_data_1202)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "help" "(startapp \"explorer\" \"https://www.offshorecad.com.ph/speeddraft/blog/sd_1202/\")")
(setq Act (start_dialog))
(unload_dialog dcl_id)
(if (= Act 0) (exit))
)
;********************************
(defun get_data_1202 ()
(setq UserWord (get_tile "Text1"))
;レジストリ書込み
(vl-registry-write Path1202 "UserWord" UserWord)
UserWord
)
;**********レジストリからデータを取得*************
(defun RegistryRead_1202()
(setq Path1202 "HKEY_CURRENT_USER\\Software\\SpeedDraft\\SD_1202")
(if (vl-registry-read Path1202 "UserWord" )
(setq UserWord (vl-registry-read Path1202 "UserWord" ))
(setq UserWord "")
)
)
(princ)
コメント