批量偏移带线
在cad中画图有很多不规则四边形等，想批量偏移一个尺寸出来，且偏移出来的线端点与原来的线端点90度角连线程序出错或用户退出:输入中的点位置不正确
为什么不能用？？
先收藏再点赞，以后用到再观看，谢谢大佬分享！ 支持一下；‘‘’’ ;;;;;;;****************************************偏移后两段封堵连线（一般用于铝板单线偏移）
;;;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:03( / en en1 pt p1 p2 p3 p4 dist)
;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>>
(vl-load-com)
(defun *error*_New (msg)
(if *error*_Old (setq *error* *error*_Old))
(if snap_old (setvar "osmode" snap_old))
(if lay_old (setvar "clayer" lay_old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(redraw)
(princ )
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(princ)
)
(setq *error*_Old *error*) ;保存出错处理函数
(setq *error* *error*_New)
(setq snap_old (getvar "osmode"))
(setq lay_old (getvar "clayer")) ; 保存当前图层
;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>>
(setvar "cmdecho" 0) ; 关闭命令响应
(command "Ortho" "on");;打开正交
(vla-startUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(setvar "osmode" 0) ; 关闭捕捉
(setvar "peditaccept" 1)
(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);检查图层是否存在，没有则新建图层，颜色为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 enpause "")
(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" "" "");;以偏移后的对象所在层连接所有线
(setq en2 (entlast))
(command "CHPROP" en2 "" "C" "BYLAYER" "LT" "BYLAYER" "S" "1""LW" "BYLAYER" "" );;恢复颜色随层
(command ".-hatch" "p" "ansi31" "1" "0" "s" en2 "" "");;;若不需要填充，可删除此行
;;;)
;;;>>>>>>>>>>>>>
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if *error*_Old (setq *error* *error*_Old))
(gc);;强制收回废内存
;;;>>>>>>>>>>>>
(setvar "osmode" snap_old)
(setvar "clayer" lay_old)
(princ)
) 我就是做铝单板的，所以想用一些插件 太牛叉了！！！ 暂时用不上，收藏下 路过，顶过，支持
路过，顶过，支持 支持一下；‘‘’’
页:
[1]
2