【AutoLISP サンプル】　引出線/マルチ引出線の矢印変更　画像ラジオボタンダイアログボックス編

コチラの記事のラジオボタンを画像ボタンにしたバージョンです。
内容は全く同じです。

コマンドの内容

引出線/マルチ引出線の矢印変更を変更します。

コマンドを実行すると、ダイアログボックスが出てきます。
画像がボタンになっているので、画像をクリックして矢印を選択します。

表示させる３枚のスライドが必要です。
こちらの記事を参考にして、スライドを用意してからこのコマンドを試してください。

コマンド名

コマンド名は AllowChanger です。好みに合わせて変えて下さい。

内容ですが、矢印は3種類、

Normal 矢印（初期値のもの）
Dot AutoCAD既存のブロック（ドット）
Ellipse ユーザーブロック “ELLIPSE”

の3種類を用意しました。

ユーザーブロックの場合は、ブロック”ELLIPSE”　を用意するか、コマンドの”ELLIPSE”の部分を変更してお使いください。

ダイアログボックス以外の、矢印を変更する部分はこちらの記事と同じです。
ダイアログボックス無しバージョン。

プログラム

DCL

DCLは、AutoLISPプログラムで呼び出すので、JagaDCL.dclという名前で、サポートファイルの検索パス内のフォルダに保存してください。

ArrowChangerImg:dialog {label= "Arrow Changer";

	
    :image_button {key="Arrow-Normal"; height=10; width=10; action="(Jaga00ArrChAction 1)";}
    :image_button {key="Arrow-Dot"; height=10; width=10; action="(Jaga00ArrChAction 2)";}
    :image_button {key="Arrow-Ellipse"; height=10; width=10; action="(Jaga00ArrChAction 3)";}
	
ok_cancel;
}

AutoLISP

(defun c:AllowChanger  (/ dcl_id Act Arrow)

   (setq dcl_id (load_dialog "JagaDCL.dcl")) ;
   
      (if (not (new_dialog "ArrowChangerImg" dcl_id))
	      (progn
            (princ "***ダイアログボックスが見つかりません***")
            (exit)
      ));if 
;-----------------------------------------------------------
  
     (Jaga00ArrChAction 1)

;-----------------------------------------------------------
      (action_tile "accept" "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
;-----------------------------------------------------------
            (setq Act (start_dialog))
            (unload_dialog dcl_id)
;-----------------------------------------------------------
            (cond 
              ((= Act 0) (princ "ユーザーキャンセル"))
              ((= Act 1) 
                    (cond 
                      ((= Arrow "Arrow-Normal")(Jaga00ChangeArrowHead 0 "" 3))
                      ((= Arrow "Arrow-Dot")(Jaga00ChangeArrowHead 3 "_Dot" 1.5))
                      ((= Arrow "Arrow-Ellipse")(Jaga00ChangeArrowHead 20 "ELLIPSE" 1)) 
                    );cond            
              );Act 1
            );cond
  ;-----------------------------------------------------------
             			
(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun Jaga00ArrChAction (Num)

    (start_image "Arrow-Normal")
       (fill_image 0 0 (dimx_tile "Arrow-Normal") (dimy_tile "Arrow-Normal") 250)
       (slide_image 0 0 (dimx_tile "Arrow-Normal")(dimy_tile "Arrow-Normal") "Arrow-Normal")	
     (end_image)
  
     (start_image "Arrow-Dot")
       (fill_image 0 0 (dimx_tile "Arrow-Dot") (dimy_tile "Arrow-Dot") 250)
       (slide_image 0 0 (dimx_tile "Arrow-Dot")(dimy_tile "Arrow-Dot") "Arrow-Dot")	
     (end_image)
  
     (start_image "Arrow-Ellipse")
       (fill_image 0 0 (dimx_tile "Arrow-Ellipse") (dimy_tile "Arrow-Ellipse") 250)
       (slide_image 0 0 (dimx_tile "Arrow-Ellipse")(dimy_tile "Arrow-Ellipse") "Arrow-Ellipse")	
     (end_image)
  
    (cond
      ((= 1 Num)(setq Arrow "Arrow-Normal"))
      ((= 2 Num)(setq Arrow "Arrow-Dot"))
      ((= 3 Num)(setq Arrow "Arrow-Ellipse"))
   )
  
  (mode_tile Arrow 4)

);defun         

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defun Jaga00ChangeArrowHead (Typ BlkNm Sz / VlOBJ)	
    
	(setq OBJs (ssget "_I" '((0 . "*LEADER"))))
		(if OBJs 
			(setq OBJ (ssname OBJs 0))
			(progn
				(setq OBJ nil flg "No")
				(while flg
					(while (null OBJ)
						(setq OBJ (car (entsel "\n引き出し線を選択: ")))
					);while null OBJ
					(if (wcmatch (cdr(assoc 0 (entget OBJ))) "*LEADER")
						(setq flg nil)
						(setq flg "No" OBJ nil)
					);if
				);while flg
			);progn	
		);if
	
  (setq VlObj (vlax-ename->vla-object Obj))
    (if (= Typ 20) 
	  	(vla-put-ArrowheadBlock VlObj BlkNm)
		  (vla-put-ArrowheadType VlObj Typ)	
	  )if
	(vla-put-ArrowheadSize VlObj Sz)
 (princ "\n=========== JagaimoLISP.com ===========") 
);defun