【方案讨论】CAD2006以下版本使用的框选剪切与延伸-------方案1
本帖最后由 wowan1314 于 2013-6-12 20:12 编辑支持块内线的----CAD2006以下用的框选剪切与延伸
最近发的两个函数，yy:getpoint与yy:getcorner. 大家认为不太实用。
其实那两函数主要是为了这个程序写的，其他方面的应用得看具体的程序要求了。
CAD2004唯一的不爽就是剪切与延伸不能框选。。。以前也发过可以框选的但不支持块内线。。
所以一直想着修正这个缺点。 这个程序还不是很完善，大家有好的建议请不吝赐教。共同完善此程序。;;;===============================================================================;;;
;;;功能：可以点选和框选的修剪和延伸命令------BY wowan1314---支持块内线 ;;;
;;;===============================================================================;;;
(defun c:W ( / NJIAN NJIANC) (trim&extend1 T))
(defun c:Z ( / NJIAN NJIANC) (trim&extend1 nil) )
(defun trim&extend1 (cmd / S1 S2 PT1 PT2 CMDECHO_OLD I XXYY:EXBLKH_SS YY:SSGET ENT EN YPT X Y PT liangx
error_end error zhuj2 zhuj1 PT3 PT4 OLDERR D2 SS1)
;;===============================增加循环框选，右键结束.
(DEFUN YY:SSGET (/ SS2 SS SS3 PT1 SSK)
;YY:SSGET主程序
(SETQ SS1 (SSADD) SS2 (SSADD) SS3 (SSADD) PT1 1 SSK (SSADD))
(while PT1
(SETQ PT1 (YY:GETPOINT '(T 12 2))) (IF PT1 (PROGN
(SETQ SS (YY:EXBLKH_SS PT1 SS3))
(AND (CAR SS) (SETQ SS1 (gxl-Sel-SSJoin SS1 (CAR SS))))
(AND (CADR SS) (SETQ SS2 (gxl-Sel-SSJoin SS2 (CADR SS))) (SETQ NJIAN SS2))
(AND (CADDR SS) (SETQ SS3 (gxl-Sel-SSJoin SS3 (CADDR SS))))
(AND (>(sslength ss1)0)(liangxian ss1 3))
))
)
(LIST SS1 SS2 SS3)
)
;;------------框选一次，如果有块，块炸到底，最后得到范围内除块和标注外的其他物体选择集
(DEFUN YY:EXBLKH_SS (P1 SS3 / P2 SS E0 SS0 SS1 S2 KC YANSE)
(if (setq S2 (ssget P1 '((0 . "~DIMENSION"))))
(PROGN
(IF (AND (ssget P1 '((0 . "INSERT"))) (SETQ SS (gxl-Sel-SSsub S2 SS3)))
(PROGN
(ss:map '(lambda (x)
(command "_.copy" X "" "0,0" "@")
(setq e0 (entlast) KC (DXF_READ 8 E0) YANSE (DXF_READ 62 (tblobjname "layer" KC)))
(YY:EXBLKALL E0);;块炸到底
(setq ss0 (last_ent e0));;块砸开后的物体集
(ss:map '(lambda (x) (AND (NOT(DXF_READ 62 X)) (YY_SubUpd X 62 YANSE)) ) SS0)
(SETQ SSK (gxl-Sel-SSJoin SS0 SSK) NJIAN SSK)
)
ss
)(SETQ P1 (osnap P1 "_near"))
(SETQ SS1 (ssget P1 '((-4 . "<AND")
(0 . "~DIMENSION")
(0 . "~INSERT")
(-4 . "AND>"))))
)
(SETQ SS1 S2)
))
(IF (CAR(SETQ P2 (YY:GETcorner P1 NIL 1314 NIL)))
(PROGN
(IF (SETQ SS (SSGET (if (minusp (CADR P2)) "_c" "_w") P1 (CAR P2) '((0 . "INSERT"))))
(PROGN
(SETQ SS (gxl-Sel-SSsub SS SS3))
(ss:map '(lambda (x)
(command "_.copy" X "" "0,0" "@")
(setq e0 (entlast) KC (DXF_READ 8 E0) YANSE (DXF_READ 62 (tblobjname "layer" KC)))
(YY:EXBLKALL E0);;块炸到底
(setq ss0 (last_ent e0));;块砸开后的物体集
(ss:map '(lambda (x) (AND (NOT(DXF_READ 62 X)) (YY_SubUpd X 62 YANSE)) ) SS0)
(SETQ SSK (gxl-Sel-SSJoin SS0 SSK) NJIAN SSK)
)
ss
))
)
(SETQ SS1 (SSGET (if (minusp (CADR P2)) "_c" "_w") P1 (CAR P2)
'((-4 . "<AND")
(0 . "~DIMENSION")
(0 . "~INSERT")
(-4 . "AND>"))))))
)
(LIST SS1 SSK SS)
)
;;-------------------------------出错函数
(defun error (x) (error_end))
(defun error_end ( / D2)
(setq *error* olderr)
(setvar "osmode" snap);打开捕捉
(IF S1 (liangxian s1 4 )) (IF SS1 (liangxian sS1 4 ))
(IF (AND NJIAN (>(SSLENGTH NJIAN)0))
(IF NJIANC (PROGN
(AND (tblobjname "layer" "NJIAN")(command ".Layer" "U" "NJIAN" ""))
(COMMAND "ERASE" NJIAN "") (SETQ D2 (VL-CATCH-ALL-APPLY 'VLA-deLETE (LIST NJIANC)))
(if(VL-CATCH-ALL-ERROR-P d2) (command "_.undo" "e"))
)
(COMMAND "ERASE" NJIAN "")
)
)
(command "_.undo" "e")
(if cm (setvar "cmdecho" cm))
)
;;;剪切主程序开始
(setq olderr *error* *error* error)
(setq CMDECHO_OLD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(redraw)
(setq liangx 1)
(if cmd
(setq cmd "_.trim"zhuj1"\n选择剪切边,或:<选择全部>:"zhuj2 "\n选择要修剪的对象，或 [栏选(F)/投影(P)/边(E)/放弃(U)]:" )
(setq cmd "_.extend"zhuj1"\n选择边界的边,或:<选择全部>:"zhuj2 "\n选择要延伸的对象，或 [栏选(F)/投影(P)/边(E)/放弃(U)]:" )
)
(princ zhuj1)
;;若没有选取边界，就将全部对象作为边界
(setq snap (getvar "osmode"))
(IF (CADR (SSGETFIRST))(PROGN
(SETQ S1 (ssget ":S" '((-4 . "<AND")
(0 . "~DIMENSION")
(0 . "~INSERT")
(-4 . "AND>")))
) (command "_.undo" "be")(setvar "osmode" 0))
(PROGN
; (setvar "nomutt" 1)
(command "_.undo" "be")
(setvar "osmode" 0)
(if (AND (CAR(setq S1 (YY:ssget))) (>(SSLENGTH (CAR S1))0))
(SETQ NJIAN (CADR S1) S1 (CAR S1))
(progn
(setq S1 (ssget "all"))
(setq liangx NIL)
)
)
; (setvar "nomutt" 0)
(IF (AND NJIAN (>(SSLENGTH NJIAN)0)) (PROGN
(SETQ NJIANC (VLA-ADD (VLA-GET-LAYERS(vla-get-ActiveDocument (vlax-get-acad-object))) "NJIAN"))
(command ".chprop" NJIAN "" "layer" "NJIAN" "")
(command ".Layer" "Lo" "NJIAN" "" )))
);END PROGN
);END IF
(IF (NULL S1)
(PROGN (princ zhuj1)
; (setvar "nomutt" 1)
(command "_.undo" "be")
(setvar "osmode" 0)
(if (AND (CAR(setq S1 (YY:ssget))) (>(SSLENGTH (CAR S1))0))
(SETQ NJIAN (CADR S1) S1 (CAR S1))
(progn
(setq S1 (ssget "all"))
(setq liangx NIL)
)
)
; (setvar "nomutt" 0)
(IF (AND NJIAN (>(SSLENGTH NJIAN)0)) (PROGN
(SETQ NJIANC (VLA-ADD (VLA-GET-LAYERS(vla-get-ActiveDocument (vlax-get-acad-object))) "NJIAN"))
(command ".chprop" NJIAN "" "layer" "NJIAN" "")
(command ".Layer" "Lo" "NJIAN" "" )))
);END PROGN
)
(liangxian S1 3 )
(SETQ PT1 1)
(while PT1
(SETQ PT1 (YY:GETPOINT '(T 12 2)))
(princ zhuj2)
(cond
;;分支零下一：栏选
((= PT1 "F")
(PROGN
(SETQ PT1 (VECTORS))
(command cmd S1 "")
(apply 'command (append (LIST "F") PT1 (LIST "")))
(COMMAND "")))
;;分支一：投影选项设置
((= PT1 "P")
(progn
(initget 4)
(setq
XX (getint (strcat "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" (itoa (getvar "PROJMODE"))">:") )
)
(if (or (= XX 0) (= XX 1) (= XX 2))
(setvar "PROJMODE" XX)
)
)
)
;;分支二：边延伸选项设置
((= PT1 "E")
(progn
(initget 4)
(setq XX (getint
(strcat
"\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <"
(itoa (getvar "EDGEMODE"))
">:"
)
)
)
(if (or (= XX 0) (= XX 1))
(setvar "EDGEMODE" XX)
)
)
)
;;分支四：撤销上一步操作
((= PT1 "U")
(command "_.undo" 1)
)
;;分支五：对选中的对象进行修剪操作
((listp PT1)
(progn
(if (setq S2 (ssget PT1 (getunlocklayer 0)))
(IF LIANGX
(progn
(command cmd S1 "" S2 "")
(liangxian s1 3 )
)
(progn
(command cmd "" S2 "")
(liangxian s1 3 )
)
)
(if (and (NULL (INITGET 32))
(setq PT2 (getcorner PT1 " >>>第二角点: "))
(setq S2 (ssget "c" PT1 PT2))
)
(IF LIANGX
(progn
(command cmd S1 "")
(progn
(setq pt3 (list (car pt1) (cadr pt2) 0.0)
pt4 (list (car pt2) (cadr pt1) 0.0)
)
(command "F" pt1 pt3 pt2 pt4 PT1 "")
)
(command "")
(liangxian s1 3 )
)
(progn
(command cmd "")
(progn
(setq pt3 (list (car pt1) (cadr pt2) 0.0)
pt4 (list (car pt2) (cadr pt1) 0.0)
)
(command "F" pt1 pt3 pt2 pt4 PT1 "")
)
(command "")
(liangxian s1 3 )
))
(princ "\n★未选择到对象。")
)
)
)
) ;_结束 分支五
) ;_结束 cond 结束分支
) ;_结束 while
(error_end)
(princ)
) ;_结束 defun
顶顶更健康 下来学习，虽然早不低版本了。支持源码 支持原碼.學習學習. 注意
2002
不能使用 现在似乎没有多少人在用08以下的版本了吧 谢谢楼主的分享！收藏备用。试了，很好用！ 本帖最后由 wowan1314 于 2013-6-6 23:03 编辑
清风明月名字 发表于 2013-6-6 19:40 static/image/common/back.gif
谢谢楼主的分享！收藏备用。试了，很好用！
程序还在调试阶段。 还有不少BUG存在。不适合使用！
如：1、大量的块会卡顿。而此时按ESC会有块内物体遗留。
2、块内图层被锁定的话，程序就不能运行了。 希望楼主大大再增加Z坐标归零和炸开多段线，扩展字典线的功能，这个修剪就更强大了。 我的本意只要做个与高版本剪切以为的程序！限于本人水平，这个基本功能都没实现呢！其他附加的功能更无从谈起了！
页:
[1]
2