马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
外国网址搬运过来的主要的是动态拖动效果
http://www.theswamp.org/index.php?topic=9133.0
- ;;
- ;; Alexander Rivilis, DynDraw\DynDraw.lsp
- ;; For book N.Poleshchuk.
- ;; "AutoCAD: Application Development, Tuning and Customization" 2006
- ;;
- ;;--------------------------------------------------------------------
- ;; (DynDraw)
- ;;--------------------------------------------------------------------
- ;;
- ;; Call:
- ;; (dyndraw
- ;; <call_back> - name of callback-function (STR)
- ;; <input_prompt> - prompt string (STR)
- ;; <keyword_list> - keyword string (as initget-string) (STR)
- ;; <input_flag> - input parameters flag (INT)
- ;; <cursor_type> - type of cursor (INT)
- ;; <base_point> - base point or nil
- ;; )
- ;;
- ;; Parameters and its value:
- ;;
- ;; 1) <call_back>
- ;; String with name of callback-function. Function *MUST* be registered
- ;; with help of: (vl-acad-defun '<call_back>)
- ;;
- ;; This function has only one parameter. Depending on <input_flag>
- ;; its can be:
- ;; 1) (X Y Z) - point, if <input_flag> is acqurePoint
- ;; 2) REAL - distance, if <input_flag> is acqureDist
- ;; 3) REAL - angle, if <input_flag> is acqureAngle
- ;; 4) STR - keyword if <keyword_list> is not empty
- ;; other string - if <input_flag> is AcceptOtherInputString
- ;;
- ;; Function *MUST* return one of values:
- ;; 1) nil - exit;
- ;; 2) (X Y Z) - point - change current point;
- ;; 3) (list ...) - list - as list of dyndraw-finction
- ;; for changing all parameters;
- ;; параметров;
- ;; 4) STR - for exit and returning STR;
- ;; 5) T - for continue without changing;
- ;;
- ;; 2) <input_prompt>
- ;; Simple prompt as for all getXXXX - functions.
- ;;
- ;; 3) <keyword_list>
- ;; String of keywords, as for (initget) function;
- ;;
- ;; 4) <input_flag>
- ;; Input flag - mast be the sum of one or more of next values
- ;;
- ;;
- ;; GovernedByOrthoMode 1
- ;; NullResponseAccepted 2
- ;; DontEchoCancelForCtrlC 4
- ;; DontUpdateLastPoint 8
- ;; NoDwgLimitsChecking 16
- ;; NoZeroResponseAccepted 32
- ;; NoNegativeResponseAccepted 64
- ;; Accept3dCoordinates 128
- ;; AcceptMouseUpAsPoint 256
- ;; AnyBlankTerminatesInput 512
- ;; InitialBlankTerminatesInput 1024
- ;; AcceptOtherInputString 2048
- ;;
- ;; and only one of next value:
- ;;
- ;; acqurePoint 0 - return point;
- ;;
- ;; acqureDist 8192 - return distance;
- ;;
- ;; acqureAngle 16384 - return angle;
- ;;
- ;;
- ;; 5) <cursor_type>
- ;; Type of cursor (INT) - one of next values:
- ;; NoSpecialCursor -1 No special cursor specified
- ;; Crosshair 0 Full screen cross hair
- ;; RectCursor 1 Rectangular cursor
- ;; RubberBand 2 Rubber band line
- ;; NotRotated 3 (AutoCAD internal use only)
- ;; TargetBox 4 Target Box type
- ;; RotatedCrosshair 5 (AutoCAD internal use only)
- ;; CrossHairNoRotate 6 Crosshairs forced non-rotated
- ;; Invisible 7 Invisible cursor
- ;; EntitySelect 8 Entity selection target cursor
- ;; Parallelogram 9 Parallelogram cursor
- ;; EntitySelectNoPersp 10 Pickbox, suppressed in persp
- ;; PkfirstOrGrips 11 Auto-select cursor
- ;;
- ;; 6) <base_point>
- ;; Base point or nil - for current cursor position.
- ;;
- ;; Function return one of next values:
- ;; 1) (X Y Z) - point, if <input_flag> is acqurePoint
- ;; 2) REAL - distance, if <input_flag> is acqureDist
- ;; 3) REAL - angle, if <input_flag> is acqureAngle
- ;; 4) STR - string, from callback-function
- ;; 5) nil - user abort
- ;;
- ;;The Particularities of the use and remarks:
- ;; 1) callback-function may not use interactive functions in all cases except
- ;; it parameter is string (keyword)
- ;; 2) If this function is using for dynamic redrawing of database resident entities
- ;; then in callback-function these entities must be updating with (entupd) or
- ;; (vla-Update).
- ;; 3) If you using (grdraw) and/or (grvecs),
- ;; you do not forget calling (redraw) for refreshing graphic window.
- ;;--------------------------------------------------------------------
- ;;--------------------------------------------------------------------
- ;; Testing program for DynDraw
- ;;--------------------------------------------------------------------
- (defun C:DYN_TEST ( / p_prev p_base p min_step
- ang dist p1 p2 p3 _bm _ce
- )
- ;; Minimal distance between points
- (setq min_step 1e-6)
- (if (null dyndraw) (progn
- (arxload "dyndraw.arx")
- )) ;_endof if progn
- ;;
- (setq _bm (getvar "blipmode") _ce (getvar "cmdecho"))
- (setvar "blipmode" 0) (setvar "cmdecho" 0)
- ;; Registering callback-function
- (vl-acad-defun 'dyn_call_back)
- (setq p (getvar "LASTPOINT"))
-
- (while
- (and dyndraw p (/= (type p) 'STR)
- (= (type (setq p (getpoint "\nBase point (ENTER - exit): "))) 'LIST))
- (setq p_base p p_prev p)
- (setq p
- (dyndraw
- ;; Name of callback - finction
- "dyn_call_back"
- ;; Prompt string
- "\nSelect point [Base point]: "
- ;; Keyword string
- "B _ B"
- ;; Input flag
- (+ 2 128 2048) ;; Allow entering empty and 3D-points
- ;; Cursor type
- 2 ;; RubberBand
- ;; Base point (in UCS)
- p
- )
- )
- (redraw)
-
- (if (= (type p) 'LIST) (progn
- ;; Adding to databse
- (setq ang (angle p_base p)
- dist (* (distance p_base p) (sqrt 2))
- p1 (polar p (+ ang (* pi 0.75)) dist)
- p2 (polar p1 (+ ang (* pi 1.25)) dist)
- p3 (polar p2 (+ ang (* pi 1.75)) dist)
- )
- (command "_.undo" "_begin")
- (command "_.pline" "_none" p "_w" 0 0 "_none" p1 "_none" p2 "_none" p3 "_c")
- (command "_.undo" "_end")
- )) ;_endof if progn
- ) ;_endof while
- (if (= (type p) 'STR)
- (princ (strcat "\nUser input string: <" p ">"))
- )
- (setvar "blipmode" _bm) (setvar "cmdecho" _ce)
- (princ)
- ) ;_endof defun
- ;;--------------------------------------------------------------------
- ;; Example of callback function
- ;;--------------------------------------------------------------------
- (defun dyn_call_back (p / p1 p2 p3)
- (cond
- ((= (type p) 'STR) ;; User select a keyword
- (redraw) ;; Clear screen
- (cond
- ((= p "B") ;; User want to change base point
- (if (setq p (getpoint p_base "\nSelect new base point: "))
- (setq p_base p
- p (list
- "dyn_call_back"
- "\nSelect new point: "
- "" ;; No keywords
- (+ 2 128 2048) ;; Allow entering empty and 3D-points
- 2 ; RubberBand
- p
- )
- )
- )
- )
- (T
- ;; Return this string
- (princ (strcat "\nUnknown keyword <" p ">!!!"))
- )
- ) ;_endof cond
- )
- ((= (type p) 'LIST) ;; Dragging with point
- (if (null p_base) (setq p_base p p_prev p))
- (if (and p_prev (> (distance p_prev p) min_step)) (progn
- (setq p_prev p)
- (setq input p
- ang (angle p_base p)
- dist (* (distance p_base input) (sqrt 2))
- p1 (polar input (+ ang (* pi 0.75)) dist)
- p2 (polar p1 (+ ang (* pi 1.25)) dist)
- p3 (polar p2 (+ ang (* pi 1.75)) dist)
- )
- (redraw) ;; Clear screen
- (grdraw input p1 -1)
- (grdraw p1 p2 -1)
- (grdraw p2 p3 -1)
- (grdraw p3 input -1)
- ))
- )
- ) ;_endof cond
- p
- ) ;_endof defun
|