本帖最后由 ㄘ丶转裑ㄧ灬 于 2016-6-10 20:42 编辑
 - ;;;;;;;****************************偏移后两段封堵连线（一般用于铝板单线偏移）
- ;;;by:kwok 2014-2-19 修改：by:QHT 2016-06-10
- ;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=109219&pid=627512&fromuid=401847
- (defun c:23( / en en1 pt p1 p2 p3 p4 dist)
- (setvar "cmdecho" 0) ; 关闭命令响应
- (command ".UNDO" "BE") ; 设置undo起点
- (setq snap (getvar "osmode"))
- (setvar "osmode" 0) ; 关闭捕捉
- (setq old_lay (getvar "clayer")) ; 保存当前图层
-
- (defun setlayer_lsp(LAY CLR)
- (if (=(tblobjname "LAYER" LAY) nil)
- (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
- '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY)))
- (entmod(subst(cons 62 CLR)(assoc 62(entget(tblobjname "LAYER" LAY)))(entget(tblobjname "LAYER" LAY))))
- )
- (setvar "CLAYER" LAY)
- )
- (setlayer_lsp "Q-铝板" 4);检查图层是否存在，没有则新建图层
- (command "offset" "L" "C" "" "");;;设置偏移后的对象到当前层，即"Q-铝板"
-
- (setq dist (getdist (strcat "\n输入偏移距离:<"
- (rtos (getvar "OFFSETDIST")) ">")))
- (if (null dist)
- (setq dist (getvar "offsetdist"))
- (setvar "offsetdist" dist) )
- ;;;(while;;;加循环
- (setq en (car(entsel "\n请选择线:")))
- (setvar "cmdecho" 1)
- (command "offset" dist en pause "")
- (setvar "cmdecho" 0)
- (setq en1 (entlast))
- (setq p1(vlax-curve-getstartpoint en)
- p2(vlax-curve-getendpoint en)
- p3(vlax-curve-getstartpoint en1)
- p4(vlax-curve-getendpoint en1))
- (command ".line" p1 p3 "" ".line" p2 p4 "")
- (command "pedit" en1 "j" "all" "" "");;以偏移后的对象所在层连接所有线
- ;;;)
- (setvar "osmode" snap)
- (setvar "clayer" old_lay) ; 恢复当前图层
- (command ".UNDO" "E")
- (princ)
- )
| 
发表于 2016-6-10 20:32:29
显身卡