共通ツール

共通ツール

[SD_1202] 寸法の下段にHを追加

下段に文字を追加する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)

コメント

この記事へのコメントはありません。

アップロードファイルの最大サイズ: 5 MB。 画像 をアップロードできます。 ここにファイルをドロップ

TOP