本帖最后由 langjs 于 2012-2-9 01:06 编辑
vlisp2012 发表于 2012-2-5 10:37 http://bbs.mjtd.com/static/image/common/back.gif
cad2011,无法使用啊！
*无效选择*
需要点或窗口(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(W ...
用这个试试
;;; =================================================================
;;; 块拉伸程序，模拟stretch（拉伸）命令对块拉伸
;;; 作者：langjs 命令：tkls 日期2012年2月4日
;;; =================================================================
(defun c:tkls (/ $orr ent i kming pt1 pt2 pt3 pt4 pt5 ptls ss)
(defun #err1001 (s) ; 出错处理函数
(command ".UNDO" "E")
(command ".UNDO" "")
(princ)
(setq *error* $orr)
)
(setq $orr *error*)
(setq *error* #err1001) ; 当程序出错时就会执行#err函数
(setvar "cmdecho" 0) ; 关闭命令响应
(command ".UNDO" "BE") ; 设置undo起点
(while (not (and
(setq ss (progn
(setq pt1 (getpoint "\n指定一个角点:")) ; 框选起点
(setq pt2 (getcorner pt1 "\n指定第二个角点:"))
(ssget "c" pt1 pt2 '((0 . "insert"))) ; 将辅助框相交的图块做成选择集
)
)
(= (sslength ss) 1)
)
)
) ; 选择一个要拉伸的块
(setq ent (entget (ssname ss 0))
pt3 (cdr (assoc 10 ent)) ; 块插入点
kming (cdr (assoc 2 ent)) ; 块名
)
(command ".explode" ss "") ; 打散块
(setq ss (ssget "p")) ; 获取打散块图元选择集
(command ".point" pt3) ; 画块的插入点标识
(setq ptls (entlast))
(sssetfirst nil (ssadd ptls (ssadd))) ; 夹点亮显块的插入点
(repeat (setq i (sslength ss))
(redraw (ssname ss (setq i (1- i))) 3)
)
(while (not (setq pt4 (getpoint "\n指定基点")))) ; 拉伸起点
(entdel ptls) ; 删除块插入点标识
(princ "\n指定第二个点或 <使用第一个点作为位移>:")
(command "_.stretch" "c" pt1 pt2 "" pt4 pause) ; 拉伸啦
(setq pt5 (getvar "lastpoint")) ; 拉伸终点
(if (and
(>= (car pt1) (car pt3))
(<= (car pt2) (car pt3))
(<= (cadr pt1) (cadr pt3))
(>= (cadr pt2) (cadr pt3))
)
(setq pt3 (list (+ (car pt3) (- (car pt5) (car pt4))) (+ (cadr pt3) (- (cadr pt5) (cadr pt4)))))
) ; 如果块插入点在拉伸框选范围内，则计算插入点到拉伸后的位置
(command "block" kming "y" pt3 ss "") ; 做块
(command "INSERT" kming pt3 1 1 0) ; 插入块
(command ".UNDO" "E") ; 设置undo终点
(setq *error* $orr)
(princ)
)
2012无法使用啊，直接炸开啦
有用没有用都要支持下！
不错的程序!!现在还用不到
作个标记先!谢谢楼主无私的分享!!
好资料。可惜2007上不能用。
2006版测试通过，只对线框有效，暂时用不着，学习和支持一下源码！
说用参照的一看就是没画过大图的，一个重生成2分钟的伤不起啊
非常不错，第一次看到这种程序
langjs 发表于 2011-3-24 23:19 static/image/common/back.gif
多个块拉伸存在逻辑问题，比如说：一张图纸上两个块块名一样，只是旋转角度不同，他们同时拉伸，拉伸后形 ...
YAD就可以多个块一起拉伸了
多选之后，可以过滤掉同名块