【AutoLISP サンプル】　星

クリックした所を中心にして、星と円を作図するコマンドです。

ツイッターでつぶやくために作ったコマンドですが、久々に作ってて楽しい！と思えたコマンドで、星がパッと出てくるのがお気に入りで、自作関数をコマンド関数内で定義したり、polar angle distance など、まだブログ無いであまり紹介していない関数も出てきたのでサンプルとして残すことにしました。

コマンドの内容

元々ツイッターでつぶやく用に少ない文字数でまとめたのがこちらです。

(defun c:STAR()(defun L(A)(polar P(* pi(/ A 180)) 600))(setq P(getPoint)B(L 90.0)C(L 306.0)D(L 162.0)E(L 18.0)F(L 234.0))(command "circle" P 600)(command "line" B C D E F B "")(foreach X(list B C D E F)(command "trim" "" "F" P(polar P(angle P X)(/(distance P X)2)) """")))

ちょっと見にくいので改行をいれて整えたものです。

(defun c:STAR ( / L P B C D E F)
   
  (defun L (A) (polar P(* pi(/ A 180)) 600))
  (setq P (getPoint) B (L 90.0) C (L 306.0) D (L 162.0) E (L 18.0) F (L 234.0))
   
  (command-s "._CIRCLE" P 600)
  (command-s "._LINE" B C D E F B "")
  
  (foreach X (list B C D E F)
    (command-s "._TRIM" "" "F" P (polar P (angle P X) (/(distance P X)2)) """"))
   
(princ));defun

中心点をユーザー入力
中心点から半径600上にある星の頂点になる5点の点座標を計算
中心点から半径600の円を描く
5つの頂点を結んで星五角形を作る
中の余分な線分をトリム

という処理をするコマンドです。

下のような図形が作図されます。

エラー対策

もし、このコマンドを実務で使おうと思って作った場合、こんなエラーが起こるだろうなと想定できるエラー対策を入れると思います。

オブジェクトスナップ

作図するコマンドは、オブジェクトスナップが影響します。
なので、オブジェクトスナップをオフにしないと、指定した点と違う所に線分が描かれる可能性があります。

オブジェクトスナップをオフにする場合は、コマンド終了時、エラー/キャンセル終了時に元のオブジェクトスナップ設定に戻るようにエラー処理も必要です。

トリム

フェンストリムをしますが、画面上にトリムをする箇所がないとエラーになります。
なのでズームで作図場所が画面上に表示にしておく必要があります。

さらに、トリム箇所にもし他の図形があればトリムで消されてしまいます。トリムのように他の図形に影響する処理がある場合は、作図下書き用の画層を使った方がいいです。

エラー対策後のコマンド

エラー対策/処理を加えたバージョンです。他の図形があっても変なトリムすることなく作図します。
星の頂点を定義する部分は mapcar と lambda を使った例にしました。
書き方が違うだけで機能は最初のコマンドと同じです。

(defun c:STAR2 (/ *error* VarLst J_Cmd J_Dyn J_OS STAR3End L P B C D E F CuLy)
  
 ;----------------------------------------- 
;システム変数の設定保存と変更

  (setq J_Cmd (getvar "CMDECHO")) ;CMDECHOの値を保存
  (setq J_Dyn (getvar "DYNMODE")) ;DYNMODEの値を保存
  (setq J_OS (getvar "OSMODE")) ;OSMODEの値を保存

  (setvar "CMDECHO" 0) ;CMDECHOの値を0にする
  (setvar "DYNMODE" 3) ;DYNMODEの値を3にする
  (setvar "OSMODE" 0) ;DYNMODEの値を0にする

;----------------------------------------- 
  
  ;----------------------------------------- 
;エラー処理 エラーが起きたらSTAR3＿Endを実行

    (defun *error* (msg)
      (princ msg)
      (STAR3End)
    (princ))
  
  ;-----------------------------------------
 
;画層復元処理（終了時かエラー時に実行）

   (defun STAR3End ()
     
     ;元の現在画層に戻す
     (if CuLy
      (command-s "._LAYER" "_T" CuLy "_SET" CuLy "")
    )
	  
    ;Lisp作業用の画層を消す
    (if (tblsearch "Layer" "JagaimoLisp_Work_Layer")
          (command-s "_laydel" "N" "JagaimoLisp_Work_Layer" "" "Y")
    );if
     
     ;画層状態を復元、保存した画層状態を消す
    (if (layerstate-has "JagaImoLisp_Work_State")
       (progn (layerstate-restore "JagaImoLisp_Work_State" nil nil)
	    	      (layerstate-delete "JagaImoLisp_Work_State")
              (command-s "._REGEN")
       );progn
    );if
     
;----------------------------------------- 
 ;システム変数を初めの設定設定に戻す
     
    (if J_Cmd (setvar "CMDECHO" J_Cmd))
     (if J_Dyn (setvar "DYNMODE" J_Dyn)) 
     (if J_OS (setvar "OSMODE" J_OS)) 

;----------------------------------------- 
     
     (princ "\n=========== JagaimoLISP.com ===========")
   );end
　　;----------------------------------------- 
;-----------------------------------------
 
;点の定義　ここではmapcar lambdaの例にしました。
;書き方が違うだけで動きは最初のコマンドと同じです。

 (setq P (getPoint "星の中心点:"))
  
   (mapcar 'set '(B C D E F)
    (mapcar
      '(lambda (A) (polar P(* pi(/ A 180)) 600))
          '(90.0 306.0 162.0 18.0 234.0)
    )
   )
  
 ;▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽
   ;|ここでは現在画層と画層状態の保存し、作業用画層を作り、それ以外の画層をフリーズします。|;
   
    (setq CuLy (getvar "CLAYER"))
	  (layerstate-save "JagaImoLisp_Work_State" nil nil)	
    (command-s ".-LAYER" "_N" "JagaimoLisp_Work_Layer" "_SET" "JagaimoLisp_Work_Layer" "_F" "*" "")
  
 ;△△△△△△△△△△△△△△△△△△△△△△△△△
   
  ; 作図する部分です。作業用画層上で作図されます。
  
    (command-s "._CIRCLE" P 600)    
    (command-s "._LINE" B C D E F B "")
    
   (foreach X (list B C D E F)
      (command-s "._TRIM" "" "F" P (polar P (angle P X) (/(distance P X)2)) """")
    );foreach

  
 ;▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽
    ;|作図した星を変数CuLyに入れたコマンド実行時の現在画層にし、
      画層復元処理が入ったSTAR3＿Endを実行します。|;
   
   (command-s "._CHANGE"  (ssget "all") "" "_P" "_LA" CuLy "")
   (STAR3End)
;△△△△△△△△△△△△△△△△△△△△△△△△△

(princ))