批量偏移带线

CAD小学徒

在cad中画图有很多不规则四边形等，想批量偏移一个尺寸出来，且偏移出来的线端点与原来的线端点90度角连线

水仙的错

程序出错或用户退出:输入中的点位置不正确
为什么不能用？？

榨菜人生

先收藏再点赞，以后用到再观看，谢谢大佬分享！

yefei812678

支持一下；‘‘’’

ㄘ丶转裑ㄧ灬

2. ;;;;;;;****************************************偏移后两段封堵连线（一般用于铝板单线偏移）
   
3. ;;;by:kwok   2014-2-19      修改：by:QHT 2016-06-10
   
4. ;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=109219&pid=627512&fromuid=401847
   
5. (defun c:03( / en en1 pt p1 p2 p3 p4 dist)
   
6. ;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>>
   
7.   (vl-load-com)
   
8.   (defun *error*_New (msg)
   
9.   (if *error*_Old (setq *error* *error*_Old))
   
10.       (if snap_old (setvar "osmode" snap_old))
    
11.     (if lay_old (setvar "clayer" lay_old))
    
12.   
    
13.   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
    
14. (redraw)
    
15.     (princ )
    
16.   )
    
17.   (vla-EndUndoMark      
    
18.     (vla-get-ActiveDocument (vlax-get-acad-object))
    
19.   )  
    
20.   (princ)
    
21. )
    
22. 
    
23. (setq *error*_Old *error*)    ;保存出错处理函数
    
24. (setq *error* *error*_New)
    
25. (setq snap_old (getvar "osmode"))
    
26. (setq lay_old (getvar "clayer")) ; 保存当前图层
    
27. ;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>>
    
28.   (setvar "cmdecho" 0) ; 关闭命令响应
    
29. (command "Ortho" "on");;打开正交
    
30. (vla-startUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
    
31. 
    
32.   
    
33.   (setvar "osmode" 0) ; 关闭捕捉
    
34.   (setvar "peditaccept" 1)
    
35.   
    
36.   (defun setlayer_lsp(LAY CLR)
    
37.   (if (=(tblobjname "LAYER" LAY) nil)
    
38.     (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
    
39.        '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY)))
    
40.     (entmod(subst(cons 62 CLR)(assoc 62(entget(tblobjname "LAYER" LAY)))(entget(tblobjname "LAYER" LAY))))
    
41.    )
    
42.    (setvar "CLAYER" LAY)
    
43.   )
    
44.   (setlayer_lsp "Q-铝板" 4);检查图层是否存在，没有则新建图层，颜色为4号色，即青色
    
45.   (command "offset" "L" "C" "" "");;;设置偏移后的对象到当前层，即"Q-铝板"
    
46.   
    
47.     (setq dist (getdist (strcat "\n输入偏移距离:<"
    
48.                               (rtos (getvar "OFFSETDIST")) ">")))
    
49.   (if (null dist)
    
50.     (setq dist (getvar "offsetdist"))
    
51.     (setvar "offsetdist" dist)  )
    
52. ;;;(while  ;;加循环
    
53.   (setq en (car(entsel "\n请选择线:")))
    
54.   (setvar "cmdecho" 1)
    
55. (command "offset" dist en  pause "")
    
56. (setvar "cmdecho" 0)
    
57. (setq en1 (entlast))
    
58. (setq p1(vlax-curve-getstartpoint en)
    
59.          p2(vlax-curve-getendpoint en)
    
60.          p3(vlax-curve-getstartpoint en1)
    
61.          p4(vlax-curve-getendpoint en1))  
    
62. (command ".line" p1 p3 ""  ".line" p2 p4 "")
    
63. 
    
64. (command "pedit" en1 "j" "all" "" "");;以偏移后的对象所在层连接所有线
    
65. (setq en2 (entlast))
    
66. (command "CHPROP" en2 "" "C" "BYLAYER" "LT" "BYLAYER" "S" "1"  "LW" "BYLAYER" "" );;恢复颜色随层
    
67. (command ".-hatch" "p" "ansi31" "1" "0" "s" en2 "" "");;;若不需要填充，可删除此行
    
68. ;;;)
    
69. ;;;>>>>>>>>>>>>>
    
70.   (vla-EndUndoMark      
    
71.     (vla-get-ActiveDocument (vlax-get-acad-object))
    
72.   )
    
73.   (if *error*_Old (setq *error* *error*_Old))
    
74.   (gc);;强制收回废内存
    
75. ;;;>>>>>>>>>>>>
    
76. (setvar "osmode" snap_old)
    
77. (setvar "clayer" lay_old)
    
78.   (princ)
    
79. )

;;;;;;;****************************************偏移后两段封堵连线（一般用于铝板单线偏移）<br /> ;;;by:kwok   2014-2-19      修改：by:QHT 2016-06-10<br /> ;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=109219&pid=627512&fromuid=401847<br /> (defun c:03( / en en1 pt p1 p2 p3 p4 dist)<br /> ;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>><br />   (vl-load-com)<br />   (defun *error*_New (msg)<br />   (if *error*_Old (setq *error* *error*_Old))<br />       (if snap_old (setvar "osmode" snap_old))<br />     (if lay_old (setvar "clayer" lay_old))<br />   <br />   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")<br /> (redraw)<br />     (princ )<br />   )<br />   (vla-EndUndoMark      <br />     (vla-get-ActiveDocument (vlax-get-acad-object))<br />   )  <br />   (princ)<br /> )<br /> <br /> (setq *error*_Old *error*)    ;保存出错处理函数<br /> (setq *error* *error*_New)<br /> (setq snap_old (getvar "osmode"))<br /> (setq lay_old (getvar "clayer")) ; 保存当前图层<br /> ;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>><br />   (setvar "cmdecho" 0) ; 关闭命令响应<br /> (command "Ortho" "on");;打开正交<br /> (vla-startUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))<br /> <br />   <br />   (setvar "osmode" 0) ; 关闭捕捉<br />   (setvar "peditaccept" 1)<br />   <br />   (defun setlayer_lsp(LAY CLR)<br />   (if (=(tblobjname "LAYER" LAY) nil)<br />     (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")<br />        '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY)))<br />     (entmod(subst(cons 62 CLR)(assoc 62(entget(tblobjname "LAYER" LAY)))(entget(tblobjname "LAYER" LAY))))<br />    ) <br />    (setvar "CLAYER" LAY)<br />   )<br />   (setlayer_lsp "Q-铝板" 4);检查图层是否存在，没有则新建图层，颜色为4号色，即青色<br />   (command "offset" "L" "C" "" "");;;设置偏移后的对象到当前层，即"Q-铝板"<br />   <br />     (setq dist (getdist (strcat "\n输入偏移距离:<"<br />                               (rtos (getvar "OFFSETDIST")) ">")))<br />   (if (null dist)<br />     (setq dist (getvar "offsetdist"))<br />     (setvar "offsetdist" dist)  )<br /> ;;;(while  ;;加循环<br />   (setq en (car(entsel "\n请选择线:")))<br />   (setvar "cmdecho" 1)<br /> (command "offset" dist en  pause "")<br /> (setvar "cmdecho" 0)<br /> (setq en1 (entlast))<br /> (setq p1(vlax-curve-getstartpoint en)<br />          p2(vlax-curve-getendpoint en) <br />          p3(vlax-curve-getstartpoint en1)<br />          p4(vlax-curve-getendpoint en1))  <br /> (command ".line" p1 p3 ""  ".line" p2 p4 "")<br /> <br /> (command "pedit" en1 "j" "all" "" "");;以偏移后的对象所在层连接所有线<br /> (setq en2 (entlast))<br /> (command "CHPROP" en2 "" "C" "BYLAYER" "LT" "BYLAYER" "S" "1"  "LW" "BYLAYER" "" );;恢复颜色随层<br /> (command ".-hatch" "p" "ansi31" "1" "0" "s" en2 "" "");;;若不需要填充，可删除此行<br /> ;;;)<br /> ;;;>>>>>>>>>>>>><br />   (vla-EndUndoMark      <br />     (vla-get-ActiveDocument (vlax-get-acad-object))<br />   )<br />   (if *error*_Old (setq *error* *error*_Old))<br />   (gc);;强制收回废内存<br /> ;;;>>>>>>>>>>>><br /> (setvar "osmode" snap_old)<br /> (setvar "clayer" lay_old)<br />   (princ)<br /> )

CAD小学徒

我就是做铝单板的，所以想用一些插件

匆匆肥马

太牛叉了！！！

zmzk

暂时用不上，收藏下

ZYX2129

路过，顶过，支持

zxc710370969

路过，顶过，支持

不语勿语

支持一下；‘‘’’