DRANKARD コマンド
以下のプロジェクトファイル、LISP ソースコードをファイルにコピーアンドペーストして、AutoCAD にロードして試してください。AutoCAD コマンド名は DRANKARD です。
プロジェクトファイル
| drunkard.prj |
|---|
(VLISP-PROJECT-LIST
:NAME
drunkard
:OWN-LIST
("support-drunkard" "random" "grvecs" "OSnapInfomation" "getPointHandler" "drunkard")
:FAS-DIRECTORY
nil
:TMP-DIRECTORY
nil
:PROJECT-KEYS
(:BUILD (:standard) :MERGED T :SAFE-MODE T :MSGLEVEL 1)
:CONTEXT-ID
:AUTOLISP
) |
LISP ソースコード
各種サポート関数
| support-drunkard.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))
|
乱数を生成する関数
| random.LSP |
|---|
(setq *INT_MAX* 2147483647
*INT_MIN* -2147483648
*INT_MAXf* (float *INT_MAX*)
*INT_MINf* (float *INT_MIN*)
)
(setq *randomSeed* 0)
;;;********************************************************************
;;;
;;; function : irand
;;; INT_MIN~INT_MAXの間の整数の乱数
;;;
;;;_$ (irand)
;;;772999773
;;;_$ (irand)
;;;-417135238
;;;_$ (irand)
;;;-473131853
;;;_$ (irand)
;;;1662200408
;;;
;;;********************************************************************
(defun irand () (setq *randomSeed* (1+ (* *randomSeed* 69069))))
;;;********************************************************************
;;;
;;; function : rnd
;;; 0.0～1.0 の間の実数の乱数
;;;
;;;_$ (rnd)
;;;0.975943
;;;_$ (rnd)
;;;0.382193
;;;_$ (rnd)
;;;0.68578
;;;_$ (rnd)
;;;0.1388
;;;
;;;********************************************************************
(defun rnd () (/ (- (irand) *INT_MINf*) (- *INT_MAXf* *INT_MINf*))) |
頂点リストから 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
) |
DRUNKERD コマンド
| drunkard.LSP |
|---|
;;;********************************************************************
;;;
;;; command : c:drunkard
;;;
;;; written by : manual chair japan
;;; date : 8/4/18
;;;
;;;********************************************************************
;;;
;;; custom get-function
;;;
(defun getDrunkardPoint (plist radius string / dPoint)
(getPointEventHandler
(car plist)
string
(function
(lambda (pt) ; on MouseMove
(grvecs (grvecs:DrawData (PolarPolygon pt radius 0 24) acRed T))
(if (<= 2 (length plist))
(grvecs (grvecs:DrawData plist acWhite nil))
)
(grvecs
(grvecs:DrawData
(list (car plist)
(setq dPoint (polar pt
(* 2 PI (rnd))
(* radius (rnd))
)
)
)
9
nil
)
)
)
)
(function (lambda (pt) ; on LeftClick
dPoint
)
)
)
)
;;;
;;; main function
;;;
(defun drunkard: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:drunkard (/ radius plist point CMDECHO BLIPMODE OSMODE *error*)
(if (and (setq radius (progn (initget (+ 1 2 4) "")
(getException 'getdist (list "\n半径を入力 : ") nil nil)
)
)
(setq start (progn (initget (+ 1 2 4) "")
(getException 'getpoint (list "\n始点を指定 : ") nil nil)
)
)
(setq
plist (progn (setq plist (list start))
(while (setq point (getException 'getDrunkardPoint
(list plist radius "\n次の点を指定 : ")
nil
'(progn (redraw) nil)
)
)
(setq plist (cons point plist))
)
(reverse plist)
)
)
(< 1 (length plist))
)
(progn (setq CMDECHO (getvar "CMDECHO")
BLIPMODE (getvar "BLIPMODE")
OSMODE (getvar "OSMODE")
*error* drunkard:error
)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(command "._undo" "_be")
;;
(drawPolyline plist nil)
;;
(command "._undo" "_e")
(setvar "CMDECHO" CMDECHO)
(setvar "BLIPMODE" BLIPMODE)
(setvar "OSMODE" OSMODE)
)
)
(princ)
) |