star コマンド

STAR コマンド

autolisp getdist

以下のプロジェクトファイル、LISP ソースコードをファイルにコピーアンドペーストして、AutoCAD にロードして試してください。AutoCAD コマンド名は STAR3 です。

プロジェクトファイル

star.prj 
(VLISP-PROJECT-LIST
  :NAME
  star
  :OWN-LIST
  ("support-star" "grvecs" "OSnapInfomation" "getPointHandler" "star")
  :FAS-DIRECTORY
  nil
  :TMP-DIRECTORY
  nil
  :PROJECT-KEYS
  (:BUILD (:standard) :MERGED T :SAFE-MODE T :MSGLEVEL 1)
  :CONTEXT-ID
  :AUTOLISP
)

LISP ソースコード

各種サポート関数

support-star.LSP 
;;;********************************************************************
;;;
;;; function : bitlist
;;;
;;;_$ (bitlist 251)
;;;(1 2 8 16 32 64 128)
;;;_$ (bitlist 365)
;;;(1 4 8 32 64 256)
;;;
;;;********************************************************************

(defun bitlist (value /)
  (vl-remove-if
    (function (lambda (i) (= (logand i value) 0)))
    '(1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 16384 32768 65536)
  )
)

;;;********************************************************************
;;;
;;; function : range
;;;
;;;_$ (range 2 6)
;;;(2 3 4 5 6)
;;;_$ (range -3 2)
;;;(-3 -2 -1 0 1 2)
;;;
;;;********************************************************************

(defun range (s e /)
  (if (<= s e)
    (cons s (range (1+ s) e))
  )
)

;;;********************************************************************
;;;
;;; function : PolarPolygon
;;;
;;;_$ (PolarPolygon '(0 0) 10 0 4)
;;;((10.0 0.0) (6.12323e-16 10.0) (-10.0 1.22465e-15) (-1.83697e-15 -10.0))
;;;_$ (PolarPolygon '(0 0) 10 (/ PI 2) 3)
;;;((6.12323e-16 10.0) (-8.66025 -5.0) (8.66025 -5.0))
;;;
;;;********************************************************************

(defun PolarPolygon (center radius offset numberOfVertex / step)
  (setq step (/ (* 2 PI) numberOfVertex))
  (mapcar (function (lambda (index) (polar center (+ offset (* step index)) radius)))
          (range 0 (1- numberOfVertex))
  )
)

;;;********************************************************************
;;;
;;; function : getException
;;;
;;;_$ (getException 'getint (list "Input index : ") 0 nil) ⏎ ; ユーザーの入力10 
;;;10
;;;_$ (getException 'getint (list "Input index : ") 0 nil) ⏎ ; 空入力
;;;0
;;;_$ (getException 'getint (list "Input index : ") 0 nil) ⏎ ; ESCキー
;;;nil
;;;
;;;********************************************************************

(defun getException (func args onEmpty onException / $error)
  (if func
    (if (vl-catch-all-error-p (setq $error (vl-catch-all-apply func args)))
      (eval onException)
      (if (= $error (if (= func 'getstring) "" nil))
        (eval onEmpty)
        $error
      )
    )
    (exit)
  )
)

;;;********************************************************************
;;;
;;; function : drawPolyline
;;;
;;;_$ (drawPolyline '((0 0) (10 0) (10 10) (0 10)) T)
;;;nil
;;;
;;;********************************************************************

(defun drawPolyline:sub (plist closed /)
  (if plist
    (progn (command (car plist)) (drawPolyline:sub (cdr plist) closed))
    (if closed
      (command "_C")
      (command "")
    )
  )
)

(defun drawPolyline (plist closed /) (command "._PLINE") (drawPolyline:sub plist closed))

頂点リストから grvecs 用の描画データを生成する関数、変換マトリックスを生成する関数

grvecs.LSP 
;;;********************************************************************
;;;
;;; function : grvecs:DrawData
;;;
;;;_$ (grvecs:DrawData '((0.0 0.0) (10.0 0.0) (10.0 10.0) (0.0 10.0)) 7 T)
;;;(7 (0.0 0.0) (10.0 0.0) 7 (10.0 0.0) (10.0 10.0) 7 (10.0 10.0) (0.0 10.0) 7 (0.0 10.0) (0.0 0.0))
;;;_$ (grvecs:DrawData '((0.0 0.0) (10.0 0.0) (10.0 10.0) (0.0 10.0)) 7 nil)
;;;(7 (0.0 0.0) (10.0 0.0) 7 (10.0 0.0) (10.0 10.0) 7 (10.0 10.0) (0.0 10.0))
;;;
;;;********************************************************************

(defun grvecs:DrawData:sub (plist / pt1 pt2)
  (if (and plist
           (setq pt1 (car plist))
           (setq pt2 (if (cadr plist)
                       (cadr plist)
                       (if closed
                         startPoint
                         nil
                       )
                     )
           )
      )
    (cons (list color pt1 pt2) (grvecs:DrawData:sub (cdr plist)))
    nil
  )
)

(defun grvecs:DrawData (plist color closed / startPoint)
  (setq startPoint (car plist))
  (apply 'append (grvecs:DrawData:sub plist))
)

;;;********************************************************************
;;;
;;; function : grvecs:TransformMatrix
;;;
;;;_$ (grvecs:TransformMatrix '(10.0 20.0 30.0) 4)
;;;((15.4629 0.0 0.0 10.0) (0.0 15.4629 0.0 20.0) (0.0 0.0 15.4629 30.0) (0.0 0.0 0.0 1.0))
;;;_$ (grvecs:TransformMatrix '(10.0 20.0 30.0) 8)
;;;((30.9258 0.0 0.0 10.0) (0.0 30.9258 0.0 20.0) (0.0 0.0 30.9258 30.0) (0.0 0.0 0.0 1.0))
;;;
;;;********************************************************************

(defun grvecs:TransformMatrix (origin scale)
  (setq origin (trans origin acUcs acDisplayDCS)
        scale  (* scale (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
  )
  (list (list scale 0.0 0.0 (car origin))
        (list 0.0 scale 0.0 (cadr origin))
        (list 0.0 0.0 scale (caddr origin))
        '(0.0 0.0 0.0 1.0)
  )
)

オブジェクトスナップと、そのマークを描く関数

OSnapInfomation.LSP 
(vl-load-com)
;;;********************************************************************
;;;
;;; function : OSnapInfomation 
;;;
;;;********************************************************************

(setq *osmodeToken*
       (list (cons 1 "_END")
             (cons 2 "_MID")
             (cons 4 "_CEN")
             (cons 8 "_NOD")
             (cons 16 "_QUA")
             (cons 32 "_INT")
             (cons 64 "_INS")
             (cons 128 "_PER")
             (cons 256 "_TAN")
             (cons 512 "_NEA")
             (cons 1024 "_GCE")
             (cons 2048 "_APP")
             (cons 4096 "_EXT")
             (cons 8192 "_PAR")
       )
)

(defun OSnapInfomation:bit->token:sub (alist / token)
  (if alist
    (if (setq token (cdr (assoc (car alist) *osmodeToken*)))
      (append (list token) (OSnapInfomation:bit->token:sub (cdr alist)))
      (OSnapInfomation:bit->token:sub (cdr alist))
    )
  )
)

(defun OSnapInfomation:bit->token (/ osmode)
  (setq osmode (getvar "OSMODE"))
  (if (/= (logand osmode 16384) 16384)
    (OSnapInfomation:bit->token:sub (bitlist osmode))
  )
)

(defun OSnapInfomation:byMode (pt tlist / spt)
  (if tlist
    (if (setq spt (osnap pt (car tlist)))
      (cons (cons (car tlist) spt) (OSnapInfomation:byMode pt (cdr tlist)))
      (OSnapInfomation:byMode pt (cdr tlist))
    )
  )
)

(defun OSnapInfomation (pt order / splist dlist)
  (if (setq splist (OSnapInfomation:byMode pt (OSnapInfomation:bit->token)))
    (progn
      (setq dlist (mapcar (function (lambda (spinfo) (distance pt (cdr spinfo)))) splist))
      (nth (vl-position (nth (rem order (length dlist)) (vl-sort dlist '<)) dlist) splist)
    )
  )
)

;;;********************************************************************
;;;
;;; function : OSnapInfomation:drawMarker
;;;
;;;********************************************************************

(setq *osnapMarkerColor* 92
      ;;
      *osnapENDMark*
       (grvecs:DrawData
         (PolarPolygon '(0 0) 1.0 (/ PI 4.0) 4)
         *osnapMarkerColor*
         T
       )
      *osnapMIDMark*
       (grvecs:DrawData
         (PolarPolygon '(0 0) 1.0 (/ PI 2.0) 3)
         *osnapMarkerColor*
         T
       )
      *osnapCENMark*
       (grvecs:DrawData (PolarPolygon '(0 0) 1.0 0.0 12) *osnapMarkerColor* T)
      *osnapINTMark*
       (append (grvecs:DrawData '((-1 -1) (1 1)) *osnapMarkerColor* nil)
               (grvecs:DrawData '((-1 1) (1 -1)) *osnapMarkerColor* nil)
       )
      *osnapNODMark*
       (append *osnapCENMark* *osnapINTMark*)
      *osnapQUAMark*
       (grvecs:DrawData (PolarPolygon '(0 0) 1.0 0.0 4) *osnapMarkerColor* T)
      *osnapINSMark*
       (grvecs:DrawData
         '((-1 1)
           (0.5 1)
           (0.5 0.5)
           (1 0.5)
           (1 -1)
           (-0.5 -1)
           (-0.5 -0.5)
           (-1 -0.5)
          )
         *osnapMarkerColor*
         T
       )
      *osnapPERMark*
       (append (grvecs:DrawData '((-1 1) (-1 -1) (1 -1)) *osnapMarkerColor* nil)
               (grvecs:DrawData '((-1 0) (0 0) (0 -1)) *osnapMarkerColor* nil)
       )
      *osnapTANMark*
       (append *osnapCENMark*
               (grvecs:DrawData '((-1 1) (1 1)) *osnapMarkerColor* nil)
       )
      *osnapNEAMark*
       (grvecs:DrawData '((1 1) (-1 1) (1 -1) (-1 -1)) *osnapMarkerColor* T)
      *osanpProvisional*
       (append *osnapCENMark*
               (grvecs:DrawData
                 (PolarPolygon '(0 0) 0.5 0.0 12)
                 *osnapMarkerColor*
                 T
               )
       )
      ;;
      *osnapMarkTable*
       (list (cons "_NON" nil)
             (cons "_END" '*osnapENDMark*)
             (cons "_MID" '*osnapMIDMark*)
             (cons "_CEN" '*osnapCENMark*)
             (cons "_INT" '*osnapINTMark*)
             (cons "_NOD" '*osnapNODMark*)
             (cons "_QUA" '*osnapQUAMark*)
             (cons "_INS" '*osnapINSMark*)
             (cons "_PER" '*osnapPERMark*)
             (cons "_TAN" '*osnapTANMark*)
             (cons "_NEA" '*osnapNEAMark*)
       )
)

(defun OSnapInfomation:drawMarker (snapInfo / marker)
  (setq marker (cdr (assoc (car snapInfo) *osnapMarkTable*)))
  (grvecs (if marker
            (eval marker)
            *osanpProvisional*          ; In other cases
          )
          (grvecs:TransformMatrix
            (cdr snapInfo)
            (* 1.5
               (vla-get-AutoSnapMarkerSize
                 (vla-get-Drafting (vla-get-Preferences (vlax-get-acad-object)))
               )
            )
          )
  )
)

カスタム入力関数のひな形となる関数

getPointHandler.LSP 
;;;********************************************************************
;;;
;;; function : getPointEventHandler
;;;
;;;********************************************************************

(defun getPointEventHandler:onMouseMove ($_pt)
  (if (and $_stillness
           (< (distance $_prePoint $_pt)
              (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
           )
      )
    (setq $_stillness T)
    (setq $_stillness nil
          $_osnapOrder 0
          $_prePoint $_pt
    )
  )
  (redraw)
  (if (setq $_osnapInfo (OSnapInfomation $_pt $_osnapOrder))
    (OSnapInfomation:drawMarker $_osnapInfo)
  )
  (apply $_onMouseMove (list $_pt))
)

(defun getPointEventHandler:onKeyPress ($_char / $_flipSystemVariable)
  (defun $_flipSystemVariable (name bitValue)
    (setvar name (Boole 6 (getvar name) bitValue))
    nil
  )
  (cond ((or (= $_char 13) (= $_char 32)) ; ENTER or SPACE
         (vl-list->string (reverse $_keyBuffer))
        )
        ((= $_char 6) ($_flipSystemVariable "OSMODE" 16384)) ; F3,Ctrl+f
        ((= $_char 25) ($_flipSystemVariable "3DOSMODE" 1)) ; F4
        ((= $_char 5)                   ; F5,Ctrl+e
         (setvar "SNAPISOPAIR" (rem (1+ (getvar "SNAPISOPAIR")) 3))
         nil
        )
        ((= $_char 4) ($_flipSystemVariable "UCSDETECT" 1)) ; F6
        ((= $_char 7) ($_flipSystemVariable "GRIDMODE" 1)) ; F7,Ctrl+g
        ((= $_char 15) ($_flipSystemVariable "ORTHOMODE" 1)) ; F8
        ((= $_char 2) ($_flipSystemVariable "SNAPMODE" 1)) ; F9
        ((= $_char 21) ($_flipSystemVariable "AUTOSNAP" 8)) ; F10
        ((= $_char 151) ($_flipSystemVariable "AUTOSNAP" 16)) ; F11
        ((= $_char 31) (setvar "DYNMODE" (- (getvar "DYNMODE"))) nil) ; F12
        ((= $_char 8)                   ; BackSpace
         (prompt (chr $_char))
         (setq $_keyBuffer (cdr $_keyBuffer))
         nil
        )
        ((= $_char 9)                   ; TAB
         (setq $_osnapOrder
                (1+ $_osnapOrder)
               $_stillness T
         )
         nil
        )
        (T (prompt (chr $_char)) (setq $_keyBuffer (cons $_char $_keyBuffer)) nil)
  )
)

(defun getPointEventHandler:loop (/ $_device $_code $_data $_osnapInfo)
  (setq $_device (grread T (+ 1 2 4 8) 0)
        $_code   (car $_device)
        $_data   (cadr $_device)
  )
  (cond ((= $_code 5)                   ;Mouse Move
         (getPointEventHandler:onMouseMove $_data)
        )
        ((= $_code 3)                   ;left click
         (apply $_onLeftClick
                (list (if (setq $_osnapInfo (OSnapInfomation $_data $_osnapOrder))
                        (cdr $_osnapInfo)
                        $_data
                      )
                )
         )
        )
        ((= $_code 25)                  ;right click
         (vl-list->string (reverse $_keyBuffer))
        )
        ((= $_code 2)                   ;key press
         (getPointEventHandler:onKeyPress $_data)
        )
  )
)

(defun getPointEventHandler ($lastPoint      $_string        $_onMouseMove
                             $_onLeftClick   /               $_flag
                             $_result        $_osnapOrder    $_stillness
                             $_prePoint      $_keyBuffer     $_lastpoint
                            )
  (if $lastPoint
    (progn (setq $_lastpoint (getvar "LASTPOINT")) (setvar "LASTPOINT" $lastPoint))
  )
  ;;
  (while (null $_flag)
    (setq $_osnapOrder 0)
    (prompt $_string)
    ;;
    (while (null $_result) (setq $_result (getPointEventHandler:loop)))
    ;;
    (if (= (type $_result) 'STR)
      (progn (prompt (strcat "\nThe $_keyBuffer is " $_result))
             ;; The following code is replaced with the 
             ;; one that analyzes the input string
             (setq $_result nil
                   $_flag T
             )
      )
      (setq $_flag T)
    )
  )
  (redraw)
  ;;
  (if $_lastpoint
    (setvar "LASTPOINT" $_lastpoint)
  )
  $_result
)

STAR コマンド

star.LSP 
;;;********************************************************************
;;;
;;; command : c:star
;;;
;;; written by : manual chair japan
;;; date : 8/4/18
;;;
;;;********************************************************************

(defun StarData (center radius / offset step)
  (setq offset (/ PI 2.0)
        step   (/ (* 2 PI) 5.0)
  )
  (apply
    'append
    (mapcar (function
              (lambda (index)
                (list (polar center (+ offset (* step index)) radius)
                      (polar center (+ offset (* step index) (/ step 2.0)) (/ radius 2.0))
                )
              )
            )
            '(0 1 2 3 4)
    )
  )
)

;;;
;;; custom get-function
;;;

(defun getStarRadius (center string /)
  (getPointEventHandler
    center
    string
    (function
      (lambda (pt)                      ; on MouseMove
        (grvecs (grvecs:DrawData (list center pt) 9 nil))
        (grvecs (grvecs:DrawData (PolarPolygon center (distance center pt) 0 24) 9 T))
        (grvecs (grvecs:DrawData (StarData center (distance center pt)) acWhite T))
      )
    )
    (function (lambda (pt) (distance center pt))) ; on LeftClick
  )
)

;;;
;;; main function
;;;

(defun star:error (msg)
  (if command-s
    (progn (command-s "._undo" "_e") (command-s "._U"))
    (progn (command "._undo" "_e") (command "._U"))
  )
  (setvar "CMDECHO" CMDECHO)
  (setvar "BLIPMODE" BLIPMODE)
  (setvar "OSMODE" OSMODE)
  (princ)
)

(defun c:star3 (/ radius center CMDECHO BLIPMODE OSMODE *error*)
  (if (and (setq center (progn (initget (+ 1 2 4) "")
                               (getException 'getpoint (list "中心を指定 : ") nil nil)
                        )
           )
           (setq radius (getException
                          'getStarRadius
                          (list center "半径を入力 : ")
                          nil
                          '(progn (redraw) nil)
                        )
           )
      )
    (progn (setq CMDECHO  (getvar "CMDECHO")
                 BLIPMODE (getvar "BLIPMODE")
                 OSMODE   (getvar "OSMODE")
                 *error*  c:star:error
           )
           (setvar "CMDECHO" 0)
           (setvar "BLIPMODE" 0)
           (setvar "OSMODE" 0)
           (command "._undo" "_be")
           ;;
           (drawPolyline (StarData center radius) T)
           (command "._HATCH" "_S" "_S" (entlast) "")
           ;;
           (command "._undo" "_e")
           (setvar "CMDECHO" CMDECHO)
           (setvar "BLIPMODE" BLIPMODE)
           (setvar "OSMODE" OSMODE)
    )
  )
  (princ)
)