DynDraw.arx

455383153 · 发表于 2018-6-29 13:07:25

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

外国网址搬运过来的主要的是动态拖动效果
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

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

/db_自贡黄明儒_ · 发表于 2018-6-29 13:15:39

看起来不错的样子，赞

sicky111 · 发表于 2018-6-30 00:24:44

动态看着爽！

sh_h · 发表于 2018-6-30 10:15:54

谢谢分享！！！

账号		自动登录	找回密码
密码			立即注册

[他山之石] DynDraw.arx

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。