用于2004及以下的框选剪切与延伸

caiqs

师兄 QQ361865648

剪切命令名:W

延伸命令名:Z

也可到www.shixiong2.ys168.com下载

zml84

学习了。。。

zml84

;;;==========================================
;;;功能：可以框选的修剪
;;;日期：ZML84 于 2007-08-20
;;;==========================================

(defun
		C:TT
		(/
		S1
		S2
		PT1
		PT2
		CMDECHO_OLD
		OSMODE_OLD
		I
		XX)

		(princ
		"\n★★可以框选的修剪★★")

		(setq
		CMDECHO_OLD
		(getvar
		"CMDECHO")
	  OSMODE_OLD
		(getvar
		"OSMODE")

		)

		(setvar
		"CMDECHO"
		0)

		(setvar
		"OSMODE"
		0)

		(princ
	(strcat
	    "\n当前设置:投影="
	    (nth
		(getvar
		"PROJMODE")
		'("不投影"
		"当前UCS"
		"当前视图"))
	    "，边="
	    (nth
		(getvar
		"EDGEMODE")
		'("不延伸"
		"延伸"))
	)

		)

		(princ
		"\n选择剪切边...")

		;;若没有选取边界，就将全部对象作为边界

		(if	(setq
		S1
		(ssget))
	()
	(setq
		S1
		(ssget
		"all"))

		)

		(while
		(progn
		(initget
		4
		"P E U")
		  (setq	PT1
			   (getpoint
			       "\n选择要修剪的对象，或 [投影(P)/边(E)/放弃(U)]:"
			   )
		  )
	   )
	(cond
	    ;;分支一：投影选项设置
	    ((=
		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))
		     (progn
			 (command
		"_.undo"
		"be")
			 (command
		"_.trim"
		S1
		""
		S2
		"")
			 (command
		"_.undo"
		"e")
		     )
		     (if
		(and
		(setq
		PT2
				       (getcorner
		PT1
						  " >>>第二角点: "
				       )
			      )
			      (setq
		S2
		(ssget
		"c"
		PT1
		PT2))
			 )
			 (progn
			     (command
		"_.undo"
		"be")
			     (command
		"_.trim"
		S1
		"")
			     (setq
		I
		0)
			     (repeat
		(sslength
		S2)
				 (command
				     (list
		(ssname
		S2
		I)
		PT1)
				 )
				 (setq
		I
		(1+
		I))
			     )
			     (command
		"")
			     (command
		"_.undo"
		"e")
			 )
			 (princ
		"\n★未选择到对象。")
		     )
		 )
	     )
	    )
		;_结束 分支五
	)
		;_结束 cond 结束分支

		)
		;_结束 while

		(setvar
		"OSMODE"
		OSMODE_OLD)

		(setvar
		"CMDECHO"
		CMDECHO_OLD)

		(princ
		"\n★正常结束。谢谢使用。")

		(princ)
)
		;_结束 defun
;;;===========================================================
(alert
		(princ
		"\n★可以框选的修剪。\n键入命令\"TT\"执行。"))
(princ)

caiqs

增加了点选功能,可点可框,效果与cad2006近似

bell888

支持，下了试试

石井鱼

这个程序相当的好，但是跟CAD的两个常用W和Z命令重叠，跪求能否将其命令改长一些，这样可以在PGP里面自定义个短的，不胜感激！希望楼主能看到这条回复，带给大家更大的方便。

xiaoyingzi

是啊，命令改长一些好啊，不然容易和自己的快捷键冲突啊，期待能改改

xyz2009xyz

为什么要编译一下呢，命令都不能修改相当不方便啊！

caiqs

最近比较忙,发现这个贴没有人气,看来是需要的人少了,我本打算把他做成和AutoCAD完全一样的效果,包括可以选块中对象为边界的,看来是没有必要了

AMTONNY

偶往上顶