设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 选择已有图形为笔刷，隨意画
返回列表 发新帖
查看: 2549|回复: 4

[每日一码] 选择已有图形为笔刷，隨意画

[复制链接]
lgx9612

已领礼包: 146个

财富等级: 日进斗金
发表于 2014-8-11 22:28:41 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
本帖最后由 lgx9612 于 2014-8-12 12:27 编辑

选择已有图形为笔刷，隨意画点击左键起笔再点击左键收笔，右键退出
  2. (defun copy_part_lgx(specify_color_lgx / filename_lgx file_sate_lgx ss_lgx n_lgx ename_lgx line_date_lgx color_lgx
  3.          start_point_lgx end_point_lgx color_lgx)
  4. (setq filename_lgx "c:\\copy_lgx.lsp")
  5. ;;;(setq filename_lgx (getfiled "选择要合并成一个lisp的原文档" "" "lsp;txt;*" 1))
  6. (setq file_sate_lgx (open filename_lgx "w"))
  7. (setq ss_lgx (ssget '((0 . "line"))))
  8. ;;;(setq grvecs_list_lgx "(list ")
  9. (write-line "( defun grvecs_lgx()" file_sate_lgx)
  10. (write-line "(setq grvecs_list_lgx (list " file_sate_lgx)
  11. (repeat (setq n_lgx (sslength ss_lgx))
  12. (setq ename_lgx (ssname ss_lgx (setq n_lgx (1- n_lgx))))
  13. (setq line_date_lgx (entget ename_lgx))  
  14. (if (= (setq color_lgx (cdr (assoc 62 line_date_lgx))) nil)
  15. (setq color_lgx 7)
  16. )
  17. (setq start_point_lgx (assoc 10 line_date_lgx))
  18. (setq end_point_lgx (assoc 11 line_date_lgx))
  19. (if (/= specify_color_lgx 1)
  20. (write-line (strcat (rtos color_lgx 2 0)
  21.    "(list (+ x_direct_lgx (* scale_lgx " (rtos (cadr start_point_lgx)) "))"
  22.    "(+ y_direct_lgx (* scale_lgx " (rtos (caddr start_point_lgx)) ")))"
  23.    "(list (+ x_direct_lgx (* scale_lgx " (rtos (cadr end_point_lgx)) "))"
  24.    "(+ y_direct_lgx (* scale_lgx " (rtos (caddr end_point_lgx)) ")))" ) file_sate_lgx)
  25. (write-line (strcat
  26.    "(list (+ x_direct_lgx (* scale_lgx " (rtos (cadr start_point_lgx)) "))"
  27.    "(+ y_direct_lgx (* scale_lgx " (rtos (caddr start_point_lgx)) ")))"
  28.    "(list (+ x_direct_lgx (* scale_lgx " (rtos (cadr end_point_lgx)) "))"
  29.    "(+ y_direct_lgx (* scale_lgx " (rtos (caddr end_point_lgx)) ")))" ) file_sate_lgx)
  30. )
  31. )
  32. (write-line " )))" file_sate_lgx)
  33. (close file_sate_lgx)
  34. filename_lgx
  35. )

  37. (defun c:pcopy_lgx(/ cm_lgx ucs_lgx filename_lgx scale_lgx file_sate_lgx base_point_lgx x_direct_lgx y_direct_lgx specify_color_lgx
  38.         loop grd_lgx)
  39. ;;;by 刘国新
  40. (setq specify_color_lgx (getstring "是否按图拷贝颜色(1为红色,其它按图的颜色)"))
  41. (setq specify_color_lgx (atoi specify_color_lgx))
  42. (setq cm_lgx (getvar "cmdecho"))
  43. (setvar "cmdecho" 0)
  44. (command "undo" "BE")
  45. (setq ucs_lgx (getvar "ucsorg"))
  46. (command "ucs" "w")
  47. (setq filename_lgx (copy_part_lgx specify_color_lgx))
  48. (setq scale_lgx (getreal "请输入缩放倍数:"))
  49. (if (= scale_lgx nil)
  50. (setq scale_lgx 1)
  51. )
  52. (if (/= (setq file_sate_lgx (open filename_lgx "r")) nil)
  53. (progn
  54. (close file_sate_lgx)
  55. (load filename_lgx)
  56. (vl-file-delete  filename_lgx)
  57. )
  58. (close file_sate_lgx)  
  59. )
  60. (princ "请输入插入点")
  61. (setq loop t)
  62. (while loop
  63. (setq grd_lgx1 (apply 'GRREAD '(t 7 0)))
  64. (if (= (car grd_lgx1) 3)
  65. (progn
  66. (setq looop t)
  67. (while looop
  68. (setq grd_lgx (apply 'GRREAD '(t 7 0)))
  69. (if (= (car grd_lgx) 3)
  70. (setq looop nil)
  71. (if (or(= (car grd_lgx) 5)(= (car grd_lgx) 3))
  72. (setq base_point_lgx (car(cdr grd_lgx)))
  73. (setq base_point_lgx nil)
  74. )
  75. )
  76. (if (/= base_point_lgx nil)
  77. (progn
  78. (setq x_direct_lgx (car base_point_lgx))
  79. (setq y_direct_lgx (cadr base_point_lgx))
  80. (princ)
  81. (grvecs_lgx)
  82. (if (/= specify_color_lgx 1)
  83. (grvecs grvecs_list_lgx)
  84. (grvecs (cons 1 grvecs_list_lgx))
  85. )
  86. )
  87. )
  88. )
  89. )
  90. (if (= (car grd_lgx1) 11)
  91. (setq loop nil)
  92. )
  93. )
  94. )
  95. (command "ucs" "n" ucs_lgx)
  96. (setvar "cmdecho" cm_lgx)
  97. )














2.gif

评分

参与人数 2D豆 +15 收起 理由
czx663 + 5 很给力!经验；技术要点；资料分享奖！
XDSoft + 10 很给力!经验；技术要点；资料分享奖！

查看全部评分

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

使用道具 举报

lucas3

已领礼包: 3199个

财富等级: 富可敌国
发表于 2014-8-12 10:05:30 | 显示全部楼层
no function definition: REGTORNOT_LGX

点评

lgx9612
不好意思，把REGTORNOT_LGX这行代码删掉吧，忘记删掉了.  详情 回复 发表于 2014-8-12 12:28
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lgx9612

已领礼包: 146个

财富等级: 日进斗金
 楼主| 发表于 2014-8-12 12:28:42 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
lucas3 发表于 2014-8-12 10:05
no function definition: REGTORNOT_LGX

不好意思，把REGTORNOT_LGX这行代码删掉吧，忘记删掉了.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zinah
发表于 2014-8-27 11:39:34 | 显示全部楼层
开来你不简单啊。膜拜了。。。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xvjiex

已领礼包: 1094个

财富等级: 财源广进
发表于 2021-6-29 00:04:05 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
感谢分享选择已有图形为笔刷
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-11-15 14:03 , Processed in 0.490650 second(s), 44 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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