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

コマンドの内容

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

コマンドを実行すると、ダイアログボックスが出てきます。
下のラジオボタンで矢印を選択すると、そのイメージが上の画像タイルに出ます。

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

コマンド名

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

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

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

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

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

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

プログラム

DCL

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

ArrowChanger:dialog {label= "JagaimoLISP　Arrow Changer";
  
       :image {key="IMG"; height=10; width=10; color = 250;} 

        :radio_column { key="Arrow"; 
            :radio_button{ label=" Normal-Size 3"; key="Arrow-Normal";}
            :radio_button{ label=" Dot-Size 1.5"; key="Arrow-Dot";}
            :radio_button{ label=" Ellipse-Size 1"; key="Arrow-Ellipse";}
          }
	ok_cancel;
}

AutoLISP

(defun c:AllowChanger  ( / dcl_id Act Arrow)

   (setq dcl_id (load_dialog "JagaDCL.dcl")) ;
   
      (if (not (new_dialog "ArrowChanger" dcl_id))
	      (progn
            (princ "***ダイアログボックスが見つかりません***")
            (exit)
      ));if 
          ;-----------------------------------------------------------
      (setq Arrow "Arrow-Normal")
      (set_tile "Arrow" Arrow)
  
     (start_image "IMG")
      (slide_image 0 0 (dimx_tile "IMG")(dimy_tile "IMG") "Arrow-Normal")	
     (end_image)
  
     (action_tile "Arrow" "(Jaga00ChArr_Action)")
  
         ;-----------------------------------------------------------
            (action_tile "accept" "(done_dialog 1)")
            (action_tile "cancel" "(done_dialog 0)")
          ;-----------------------------------------------------------
            (setq Act (start_dialog))
            (unload_dialog dcl_id)
          ;-----------------------------------------------------------
           (if (= 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
          );if          
          ;----------------------------------------------------------				
(princ));defun

;=================================test
(defun Jaga00ChArr_Action ()

  (setq Arrow (get_tile "Arrow"))
  
  (start_image "IMG")
      (fill_image 0 0 (dimx_tile "IMG") (dimy_tile "IMG") 250)
      (slide_image 0 0 (dimx_tile "IMG")(dimy_tile "IMG") Arrow)	
  (end_image)

);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