设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 【方案讨论】CAD2006以下版本使用的框选剪切与延伸----- ...
12下一页
返回列表 发新帖
查看: 6094|回复: 17

[源码] 【方案讨论】CAD2006以下版本使用的框选剪切与延伸-------方案1

[复制链接]
wowan1314
发表于 2013-6-4 17:07:33 | 显示全部楼层 |阅读模式
本帖最后由 wowan1314 于 2013-6-12 20:12 编辑

                                                  支持块内线的----CAD2006以下用的框选剪切与延伸
          最近发的两个函数，yy:getpoint与yy:getcorner.    大家认为不太实用。
其实那两函数主要是为了这个程序写的，其他方面的应用得看具体的程序要求了。

CAD2004唯一的不爽就是剪切与延伸不能框选。。。以前也发过可以框选的但不支持块内线。。

所以一直想着修正这个缺点。 这个程序还不是很完善，大家有好的建议请不吝赐教。共同完善此程序。
  2. ;;;===============================================================================;;;
  3. ;;;功能：可以点选和框选的修剪和延伸命令------BY wowan1314  ---支持块内线          ;;;
  4. ;;;===============================================================================;;;
  5. (defun c:W ( / NJIAN NJIANC) (trim&extend1 T)  )
  6. (defun c:Z ( / NJIAN NJIANC) (trim&extend1 nil) )
  7. (defun trim&extend1 (cmd / S1 S2 PT1 PT2 CMDECHO_OLD I XX  YY:EXBLKH_SS YY:SSGET ENT EN YPT X Y PT liangx
  8.                            error_end error zhuj2 zhuj1 PT3 PT4 OLDERR D2 SS1)  
  9. ;;===============================增加循环框选，右键结束.
  10. (DEFUN YY:SSGET (/ SS2 SS SS3 PT1 SSK)
  11. ;YY:SSGET主程序
  12. (SETQ SS1 (SSADD) SS2 (SSADD) SS3 (SSADD) PT1 1 SSK (SSADD))
  13. (while PT1
  14.   (SETQ PT1 (YY:GETPOINT '(T 12 2))) (IF PT1 (PROGN
  15.   (SETQ SS (YY:EXBLKH_SS PT1 SS3))
  16.   (AND (CAR SS) (SETQ SS1 (gxl-Sel-SSJoin SS1 (CAR SS))))
  17.   (AND (CADR SS) (SETQ SS2 (gxl-Sel-SSJoin SS2 (CADR SS))) (SETQ NJIAN SS2))
  18.   (AND (CADDR SS) (SETQ SS3 (gxl-Sel-SSJoin SS3 (CADDR SS))))
  19.   (AND (>(sslength ss1)0)(liangxian ss1 3))
  20.               ))
  21. )
  22. (LIST SS1 SS2 SS3)
  23. )

  25. ;;------------框选一次，如果有块，块炸到底，最后得到范围内除块和标注外的其他物体选择集
  26. (DEFUN YY:EXBLKH_SS (P1 SS3 / P2 SS E0 SS0 SS1 S2 KC YANSE)
  27. (if (setq S2 (ssget P1 '((0 . "~DIMENSION"))))
  28.   (PROGN
  29.     (IF (AND (ssget P1 '((0 . "INSERT"))) (SETQ SS (gxl-Sel-SSsub S2 SS3)))
  30.        (PROGN
  31.     (ss:map '(lambda (x)   
  32.         (command "_.copy" X "" "0,0" "@")
  33.        (setq e0 (entlast) KC (DXF_READ 8 E0) YANSE (DXF_READ 62 (tblobjname "layer" KC)))
  34.       (YY:EXBLKALL E0);;块炸到底
  35.        (setq ss0 (last_ent e0));;块砸开后的物体集
  36.        (ss:map '(lambda (x) (AND (NOT(DXF_READ 62 X)) (YY_SubUpd X 62 YANSE)) ) SS0)
  37.         (SETQ SSK (gxl-Sel-SSJoin SS0 SSK) NJIAN SSK)
  38.       )
  39.      ss
  40.     )(SETQ P1 (osnap P1 "_near"))
  41.      (SETQ SS1 (ssget P1 '((-4 . "<AND")
  42.     (0 . "~DIMENSION")
  43.     (0 . "~INSERT")
  44.     (-4 . "AND>"))))
  45.    )
  46.   (SETQ SS1 S2)
  47.   ))
  48.   (IF (CAR(SETQ P2 (YY:GETcorner P1 NIL 1314 NIL)))
  49.    (PROGN
  50.    (IF (SETQ SS (SSGET (if (minusp (CADR P2)) "_c" "_w") P1 (CAR P2) '((0 . "INSERT"))))
  51.     (PROGN
  52.     (SETQ SS (gxl-Sel-SSsub SS SS3))
  53.     (ss:map '(lambda (x)   
  54.         (command "_.copy" X "" "0,0" "@")
  55.        (setq e0 (entlast) KC (DXF_READ 8 E0) YANSE (DXF_READ 62 (tblobjname "layer" KC)))
  56.       (YY:EXBLKALL E0);;块炸到底
  57.        (setq ss0 (last_ent e0));;块砸开后的物体集
  58.        (ss:map '(lambda (x) (AND (NOT(DXF_READ 62 X)) (YY_SubUpd X 62 YANSE)) ) SS0)
  59.         (SETQ SSK (gxl-Sel-SSJoin SS0 SSK) NJIAN SSK)
  60.       )
  61.      ss
  62.     ))
  63.    )
  64.    (SETQ SS1 (SSGET (if (minusp (CADR P2)) "_c" "_w") P1 (CAR P2)
  65.     '((-4 . "<AND")
  66.     (0 . "~DIMENSION")
  67.     (0 . "~INSERT")
  68.     (-4 . "AND>"))))))
  69. )
  70. (LIST SS1 SSK SS)
  71. )
  72. ;;-------------------------------出错函数
  73.    (defun error (x) (error_end))
  74.    (defun error_end ( / D2)
  75.       (setq *error* olderr)
  76.       (setvar "osmode" snap);打开捕捉
  77.      (IF S1 (liangxian s1 4 )) (IF SS1 (liangxian sS1 4 ))
  78.      (IF (AND NJIAN (>(SSLENGTH NJIAN)0))
  79.            (IF NJIANC (PROGN
  80.               (AND (tblobjname "layer" "NJIAN")(command ".Layer" "U" "NJIAN" ""))
  81.               (COMMAND "ERASE" NJIAN "") (SETQ D2 (VL-CATCH-ALL-APPLY 'VLA-deLETE (LIST NJIANC)))
  82.               (if(VL-CATCH-ALL-ERROR-P d2) (command "_.undo" "e"))
  83.                       )
  84.               (COMMAND "ERASE" NJIAN "")
  85.            )
  86.      )
  87.      (command "_.undo" "e")
  88.       (if cm (setvar "cmdecho" cm))
  89.    )
  90. ;;;剪切主程序开始
  91.    (setq olderr *error* *error* error)
  92.    (setq CMDECHO_OLD (getvar "CMDECHO"))
  93.    (setvar "CMDECHO" 0)
  94.    (redraw)
  95.    (setq liangx 1)

  97.    (if cmd
  98.       (setq cmd "_.trim"  zhuj1  "\n选择剪切边,或:<选择全部>:"  zhuj2    "\n选择要修剪的对象，或 [栏选(F)/投影(P)/边(E)/放弃(U)]:" )
  99.       (setq cmd "_.extend"  zhuj1  "\n选择边界的边,或:<选择全部>:"  zhuj2   "\n选择要延伸的对象，或 [栏选(F)/投影(P)/边(E)/放弃(U)]:" )
  100.    )

  102.    (princ zhuj1)
  103.    ;;若没有选取边界，就将全部对象作为边界
  104.    (setq snap (getvar "osmode"))

  106. (IF (CADR (SSGETFIRST))(PROGN
  107.   (SETQ S1 (ssget ":S" '((-4 . "<AND")
  108.     (0 . "~DIMENSION")
  109.     (0 . "~INSERT")
  110.     (-4 . "AND>")))
  111.   ) (command "_.undo" "be")(setvar "osmode" 0))
  112. (PROGN
  113. ;   (setvar "nomutt" 1)
  114.   (command "_.undo" "be")
  115. (setvar "osmode" 0)
  116.    (if (AND (CAR(setq S1 (YY:ssget))) (>(SSLENGTH (CAR S1))0))
  117.       (SETQ NJIAN (CADR S1) S1 (CAR S1))
  118.       (progn
  119.          (setq S1 (ssget "all"))
  120.          (setq liangx NIL)
  121.       )
  122.    )
  123. ;   (setvar "nomutt" 0)
  124. (IF (AND NJIAN (>(SSLENGTH NJIAN)0)) (PROGN
  125. (SETQ NJIANC (VLA-ADD (VLA-GET-LAYERS(vla-get-ActiveDocument (vlax-get-acad-object))) "NJIAN"))
  126. (command ".chprop" NJIAN "" "layer" "NJIAN" "")
  127. (command ".Layer" "Lo" "NJIAN" "" )))
  128. );END PROGN
  129. );END IF

  131. (IF (NULL S1)
  132. (PROGN (princ zhuj1)
  133. ;   (setvar "nomutt" 1)
  134.   (command "_.undo" "be")
  135. (setvar "osmode" 0)
  136.    (if (AND (CAR(setq S1 (YY:ssget))) (>(SSLENGTH (CAR S1))0))
  137.       (SETQ NJIAN (CADR S1) S1 (CAR S1))
  138.       (progn
  139.          (setq S1 (ssget "all"))
  140.          (setq liangx NIL)
  141.       )
  142.    )
  143. ;   (setvar "nomutt" 0)
  144. (IF (AND NJIAN (>(SSLENGTH NJIAN)0)) (PROGN
  145. (SETQ NJIANC (VLA-ADD (VLA-GET-LAYERS(vla-get-ActiveDocument (vlax-get-acad-object))) "NJIAN"))
  146. (command ".chprop" NJIAN "" "layer" "NJIAN" "")
  147. (command ".Layer" "Lo" "NJIAN" "" )))
  148. );END PROGN
  149. )

  151. (liangxian S1 3 )
  152. (SETQ PT1 1)
  153.    (while PT1
  154.       (SETQ PT1 (YY:GETPOINT '(T 12 2)))
  155.       (princ zhuj2)
  156.   (cond
  157.       ;;分支零下一：栏选
  158.         ((= PT1 "F")
  159.          (PROGN
  160.            (SETQ PT1 (VECTORS))
  161.            (command cmd S1 "")
  162.            (apply 'command (append (LIST "F") PT1 (LIST "")))
  163.            (COMMAND "")))
  164.       ;;分支一：投影选项设置
  165.         ((= PT1 "P")
  166.        (progn
  167.        (initget 4)
  168.        (setq
  169.            XX (getint (strcat "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" (itoa (getvar "PROJMODE"))  ">:"  ) )
  170.        )
  171.        (if (or (= XX 0) (= XX 1) (= XX 2))
  172.              (setvar "PROJMODE" XX)
  173.        )
  174.        )
  175.       )
  176.       ;;分支二：边延伸选项设置
  177.         ((= PT1 "E")
  178.        (progn
  179.        (initget 4)
  180.        (setq XX (getint
  181.                 (strcat
  182.                   "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <"
  183.                   (itoa (getvar "EDGEMODE"))
  184.                   ">:"
  185.                 )
  186.             )
  187.        )
  188.        (if (or (= XX 0) (= XX 1))
  189.              (setvar "EDGEMODE" XX)
  190.        )
  191.        )
  192.       )
  193.       ;;分支四：撤销上一步操作
  194.         ((= PT1 "U")
  195.          (command "_.undo" 1)
  196.       )
  197.       ;;分支五：对选中的对象进行修剪操作
  198.       ((listp PT1)
  199.       (progn
  200.       (if (setq S2 (ssget PT1 (getunlocklayer 0)))
  201.         (IF LIANGX
  202.           (progn
  203.              (command cmd S1 "" S2 "")
  204.              (liangxian s1 3 )
  205.           )
  206.           (progn
  207.              (command cmd "" S2 "")
  208.              (liangxian s1 3 )
  209.           )
  210.         )
  211.           (if (and (NULL (INITGET 32))
  212.                    (setq PT2 (getcorner PT1 " >>>第二角点: "))
  213.                    (setq S2 (ssget "c" PT1 PT2))
  214.               )
  215.            (IF LIANGX
  216.              (progn           
  217.                 (command cmd S1 "")
  218.                   (progn
  219.                   (setq pt3 (list (car pt1) (cadr pt2) 0.0)
  220.                         pt4 (list (car pt2) (cadr pt1) 0.0)
  221.                   )
  222.                   (command "F" pt1 pt3 pt2 pt4 PT1 "")
  223.                   )
  224.                   (command "")
  225.                 (liangxian s1 3 )
  226.                  
  227.              )
  228.              (progn           
  229.                 (command cmd "")
  230.                   (progn
  231.                   (setq pt3 (list (car pt1) (cadr pt2) 0.0)
  232.                         pt4 (list (car pt2) (cadr pt1) 0.0)
  233.                   )
  234.                   (command "F" pt1 pt3 pt2 pt4 PT1 "")
  235.                   )
  236.                   (command "")
  237.                 (liangxian s1 3 )
  238.                  
  239.              ))
  240.              (princ "\n★未选择到对象。")
  241.          )
  242.      )
  243.      )
  244.       ) ;_结束 分支五
  245.   ) ;_结束 cond 结束分支
  246.    ) ;_结束 while
  247.    (error_end)
  248.    (princ)
  249. ) ;_结束 defun

本帖子中包含更多资源

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

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

maiko
发表于 2013-6-4 17:09:23 | 显示全部楼层
顶顶更健康
回复 支持 反对

使用道具 举报

kwok
发表于 2013-6-4 18:43:36 来自手机 | 显示全部楼层
下来学习，虽然早不低版本了。支持源码
回复 支持 反对

使用道具 举报

xiaoyuzj-503
发表于 2013-6-4 21:20:10 | 显示全部楼层
支持原碼.學習學習.
回复 支持 反对

使用道具 举报

crtrccrt
发表于 2013-6-5 14:14:20 | 显示全部楼层
注意
2002
不能使用
回复 支持 反对

使用道具 举报

shalei021647
发表于 2013-6-6 17:58:08 | 显示全部楼层
现在似乎没有多少人在用08以下的版本了吧
回复 支持 反对

使用道具 举报

清风明月名字
发表于 2013-6-6 19:40:50 | 显示全部楼层
谢谢楼主的分享！收藏备用。试了，很好用！
回复 支持 反对

使用道具 举报

wowan1314
 楼主| 发表于 2013-6-6 20:17:13 | 显示全部楼层
本帖最后由 wowan1314 于 2013-6-6 23:03 编辑
清风明月名字 发表于 2013-6-6 19:40
谢谢楼主的分享！收藏备用。试了，很好用！

程序还在调试阶段。 还有不少BUG存在。  不适合使用！

如：1、大量的块会卡顿。而此时按ESC会有块内物体遗留。

      2、块内图层被锁定的话，程序就不能运行了。
回复 支持 反对

使用道具 举报

crazylsp
发表于 2013-6-6 21:25:10 | 显示全部楼层
希望楼主大大再增加Z坐标归零和炸开多段线，扩展字典线的功能，这个修剪就更强大了。
回复 支持 反对

使用道具 举报

wowan1314
 楼主| 发表于 2013-6-6 23:26:59 | 显示全部楼层
我的本意只要做个与高版本剪切以为的程序！限于本人水平，这个基本功能都没实现呢！其他附加的功能更无从谈起了！
回复 支持 反对

使用道具 举报

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

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-21 00:53 , Processed in 0.216141 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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