找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 741|回复: 3

[他山之石] DynDraw.arx

[复制链接]

已领礼包: 19个

财富等级: 恭喜发财

发表于 2018-6-29 13:07:25 | 显示全部楼层 |阅读模式

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

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

×
外国网址搬运过来的主要的是动态拖动效果
http://www.theswamp.org/index.php?topic=9133.0
  1. ;;
  2. ;; Alexander Rivilis, DynDraw\DynDraw.lsp
  3. ;; For book N.Poleshchuk.
  4. ;; "AutoCAD: Application Development, Tuning and Customization" 2006
  5. ;;
  6. ;;--------------------------------------------------------------------
  7. ;;                           (DynDraw)
  8. ;;--------------------------------------------------------------------
  9. ;;
  10. ;; Call:
  11. ;;  (dyndraw
  12. ;;    <call_back>      - name of callback-function (STR)
  13. ;;    <input_prompt>   - prompt string (STR)
  14. ;;    <keyword_list>   - keyword string (as initget-string) (STR)
  15. ;;    <input_flag>     - input parameters flag (INT)
  16. ;;    <cursor_type>    - type of cursor (INT)        
  17. ;;    <base_point>     - base point or nil
  18. ;;  )
  19. ;;
  20. ;; Parameters and its value:
  21. ;;
  22. ;;  1) <call_back>
  23. ;;     String with name of callback-function. Function *MUST* be registered
  24. ;;     with help of: (vl-acad-defun '<call_back>)
  25. ;;     
  26. ;;     This function has only one parameter. Depending on <input_flag>
  27. ;;     its can be:
  28. ;;     1) (X Y Z)      - point,    if <input_flag> is acqurePoint
  29. ;;     2) REAL         - distance, if <input_flag> is acqureDist
  30. ;;     3) REAL         - angle,    if <input_flag> is acqureAngle
  31. ;;     4) STR          - keyword   if <keyword_list> is not empty
  32. ;;                       other string - if <input_flag> is AcceptOtherInputString
  33. ;;
  34. ;;     Function *MUST* return one of values:
  35. ;;     1) nil          - exit;
  36. ;;     2) (X Y Z)      - point - change current point;
  37. ;;     3) (list ...)   - list - as list of dyndraw-finction
  38. ;;                       for changing all parameters;
  39. ;;                       параметров;
  40. ;;     4) STR          - for exit and returning STR;
  41. ;;     5) T            - for continue without changing;
  42. ;;                     
  43. ;;  2) <input_prompt>
  44. ;;     Simple prompt as for all getXXXX - functions.
  45. ;;
  46. ;;  3) <keyword_list>  
  47. ;;     String of keywords, as for (initget) function;
  48. ;;
  49. ;;  4) <input_flag>   
  50. ;;     Input flag - mast be the sum of one or more  of next values
  51. ;;     
  52. ;;
  53. ;;     GovernedByOrthoMode             1
  54. ;;     NullResponseAccepted            2
  55. ;;     DontEchoCancelForCtrlC          4
  56. ;;     DontUpdateLastPoint             8
  57. ;;     NoDwgLimitsChecking            16
  58. ;;     NoZeroResponseAccepted         32
  59. ;;     NoNegativeResponseAccepted     64
  60. ;;     Accept3dCoordinates           128
  61. ;;     AcceptMouseUpAsPoint          256
  62. ;;     AnyBlankTerminatesInput       512
  63. ;;     InitialBlankTerminatesInput  1024
  64. ;;     AcceptOtherInputString       2048
  65. ;;
  66. ;;     and only one of next value:
  67. ;;
  68. ;;     acqurePoint        0  -  return point;
  69. ;;                           
  70. ;;     acqureDist      8192  -  return distance;
  71. ;;        
  72. ;;     acqureAngle    16384  -  return angle;
  73. ;;                              
  74. ;;
  75. ;;  5) <cursor_type>
  76. ;;     Type of cursor (INT) - one of next values:
  77. ;;     NoSpecialCursor      -1      No special cursor specified
  78. ;;     Crosshair             0      Full screen cross hair
  79. ;;     RectCursor            1      Rectangular cursor
  80. ;;     RubberBand            2      Rubber band line
  81. ;;     NotRotated            3      (AutoCAD internal use only)
  82. ;;     TargetBox             4      Target Box type
  83. ;;     RotatedCrosshair      5      (AutoCAD internal use only)
  84. ;;     CrossHairNoRotate     6      Crosshairs forced non-rotated
  85. ;;     Invisible             7      Invisible cursor
  86. ;;     EntitySelect          8      Entity selection target cursor
  87. ;;     Parallelogram         9      Parallelogram cursor
  88. ;;     EntitySelectNoPersp  10      Pickbox, suppressed in persp
  89. ;;     PkfirstOrGrips       11      Auto-select cursor
  90. ;;
  91. ;;  6) <base_point>
  92. ;;     Base point or nil - for current cursor position.
  93. ;;
  94. ;; Function return one of next values:
  95. ;;     1) (X Y Z)      - point,    if <input_flag> is acqurePoint
  96. ;;     2) REAL         - distance, if <input_flag> is acqureDist
  97. ;;     3) REAL         - angle,    if <input_flag> is acqureAngle
  98. ;;     4) STR          - string,   from callback-function
  99. ;;     5) nil          - user abort
  100. ;;
  101. ;;The Particularities of the use and remarks:
  102. ;; 1) callback-function may not use interactive functions in all cases except
  103. ;;    it parameter is string (keyword)
  104. ;; 2) If this function is using for dynamic redrawing of database resident entities
  105. ;;    then in callback-function these entities must be updating with (entupd) or
  106. ;;    (vla-Update).
  107. ;; 3) If you using (grdraw) and/or (grvecs),
  108. ;;    you do not forget calling (redraw) for refreshing graphic window.
  109. ;;--------------------------------------------------------------------

  110. ;;--------------------------------------------------------------------
  111. ;;      Testing program for DynDraw
  112. ;;--------------------------------------------------------------------
  113. (defun C:DYN_TEST ( / p_prev p_base p min_step
  114.                       ang dist p1 p2 p3 _bm _ce
  115.                   )
  116.   ;; Minimal distance between points
  117.   (setq min_step 1e-6)
  118.   (if (null dyndraw) (progn
  119.     (arxload "dyndraw.arx")
  120.   )) ;_endof if progn
  121.   ;;
  122.   (setq _bm (getvar "blipmode") _ce (getvar "cmdecho"))
  123.   (setvar "blipmode" 0) (setvar "cmdecho" 0)
  124.   ;; Registering callback-function
  125.   (vl-acad-defun 'dyn_call_back)
  126.   (setq p (getvar "LASTPOINT"))
  127.   
  128.   (while
  129.     (and dyndraw p (/= (type p) 'STR)
  130.          (= (type (setq p (getpoint "\nBase point (ENTER - exit): "))) 'LIST))
  131.     (setq p_base p p_prev p)
  132.     (setq p
  133.       (dyndraw
  134.          ;; Name of callback - finction
  135.          "dyn_call_back"
  136.          ;; Prompt string
  137.          "\nSelect point [Base point]: "
  138.          ;; Keyword string
  139.          "B _ B"   
  140.          ;; Input flag
  141.          (+ 2 128 2048) ;; Allow entering empty and 3D-points
  142.          ;; Cursor type
  143.          2 ;;  RubberBand
  144.          ;; Base point (in UCS)
  145.          p
  146.       )
  147.     )
  148.     (redraw)
  149.    
  150.     (if (= (type p) 'LIST) (progn
  151.       ;; Adding to databse
  152.       (setq ang   (angle p_base p)
  153.             dist  (* (distance p_base p) (sqrt 2))
  154.             p1    (polar p (+ ang (* pi 0.75)) dist)
  155.             p2    (polar p1 (+ ang (* pi 1.25)) dist)
  156.             p3    (polar p2 (+ ang (* pi 1.75)) dist)
  157.       )
  158.       (command "_.undo" "_begin")
  159.       (command "_.pline" "_none" p "_w" 0 0 "_none" p1  "_none" p2  "_none" p3 "_c")
  160.       (command "_.undo" "_end")
  161.     )) ;_endof if progn
  162.   ) ;_endof while
  163.   (if (= (type p) 'STR)
  164.     (princ (strcat "\nUser input string: <" p ">"))
  165.   )

  166.   (setvar "blipmode" _bm) (setvar "cmdecho" _ce)
  167.   (princ)
  168. ) ;_endof defun
  169. ;;--------------------------------------------------------------------
  170. ;;               Example of callback function
  171. ;;--------------------------------------------------------------------
  172. (defun dyn_call_back (p / p1 p2 p3)
  173. (cond
  174.   ((= (type p) 'STR) ;; User select a keyword
  175.     (redraw) ;; Clear screen
  176.     (cond
  177.      ((= p "B") ;; User want to change base point
  178.       (if (setq p (getpoint p_base "\nSelect new base point: "))
  179.         (setq p_base p
  180.               p  (list
  181.                   "dyn_call_back"
  182.                   "\nSelect new point: "
  183.                   "" ;; No keywords
  184.                   (+ 2 128 2048) ;; Allow entering empty and 3D-points
  185.                   2 ; RubberBand
  186.                   p
  187.                  )
  188.          )
  189.       )
  190.      )
  191.      (T
  192.       ;; Return this string
  193.       (princ (strcat "\nUnknown keyword <" p ">!!!"))
  194.      )
  195.     ) ;_endof cond
  196.   )
  197.   ((= (type p) 'LIST) ;; Dragging with point
  198.     (if (null p_base) (setq p_base p p_prev p))
  199.     (if (and p_prev (> (distance p_prev p) min_step)) (progn
  200.       (setq p_prev p)
  201.       (setq input p
  202.             ang   (angle p_base p)
  203.             dist  (* (distance p_base input) (sqrt 2))
  204.             p1    (polar input (+ ang (* pi 0.75)) dist)
  205.             p2    (polar p1 (+ ang (* pi 1.25)) dist)
  206.             p3    (polar p2 (+ ang (* pi 1.75)) dist)
  207.        )
  208.        (redraw) ;; Clear screen
  209.        (grdraw input p1 -1)
  210.        (grdraw p1 p2 -1)
  211.        (grdraw p2 p3 -1)
  212.        (grdraw p3 input -1)
  213.     ))
  214.   )
  215. ) ;_endof cond
  216. p
  217. ) ;_endof defun

111.gif

dyndraw.zip

291.57 KB, 阅读权限: 10, 下载次数: 8, 下载积分: D豆 -1 , 活跃度 1

arx

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 604个

财富等级: 财运亨通

发表于 2018-6-29 13:15:39 | 显示全部楼层
看起来不错的样子,赞
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6468个

财富等级: 富甲天下

发表于 2018-6-30 00:24:44 | 显示全部楼层
动态看着爽!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 769个

财富等级: 财运亨通

发表于 2018-6-30 10:15:54 | 显示全部楼层
谢谢分享!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-28 17:34 , Processed in 0.229420 second(s), 38 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表