明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2163|回复: 12

批量偏移带线

  [复制链接]
发表于 2016-7-26 10:48 | 显示全部楼层 |阅读模式
在cad中画图有很多不规则四边形等,想批量偏移一个尺寸出来,且偏移出来的线端点与原来的线端点90度角连线
发表于 2019-9-13 22:09 | 显示全部楼层
程序出错或用户退出:输入中的点位置不正确
为什么不能用??

发表于 2023-11-12 10:35 | 显示全部楼层
先收藏再点赞,以后用到再观看,谢谢大佬分享!
发表于 2024-2-26 17:14 | 显示全部楼层
支持一下;‘‘’’
发表于 2016-7-26 16:10 | 显示全部楼层
  1. ;;;;;;;****************************************偏移后两段封堵连线(一般用于铝板单线偏移)
  2. ;;;by:kwok   2014-2-19      修改:by:QHT 2016-06-10
  3. ;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=109219&pid=627512&fromuid=401847
  4. (defun c:03( / en en1 pt p1 p2 p3 p4 dist)
  5. ;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>>
  6.   (vl-load-com)
  7.   (defun *error*_New (msg)
  8.   (if *error*_Old (setq *error* *error*_Old))
  9.       (if snap_old (setvar "osmode" snap_old))
  10.     (if lay_old (setvar "clayer" lay_old))
  11.   
  12.   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
  13. (redraw)
  14.     (princ )
  15.   )
  16.   (vla-EndUndoMark      
  17.     (vla-get-ActiveDocument (vlax-get-acad-object))
  18.   )  
  19.   (princ)
  20. )

  21. (setq *error*_Old *error*)    ;保存出错处理函数
  22. (setq *error* *error*_New)
  23. (setq snap_old (getvar "osmode"))
  24. (setq lay_old (getvar "clayer")) ; 保存当前图层
  25. ;;;>>>>>>>>>>>>>>--出错处理-->>>>>>>>>>>>>>>>
  26.   (setvar "cmdecho" 0) ; 关闭命令响应
  27. (command "Ortho" "on");;打开正交
  28. (vla-startUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))

  29.   
  30.   (setvar "osmode" 0) ; 关闭捕捉
  31.   (setvar "peditaccept" 1)
  32.   
  33.   (defun setlayer_lsp(LAY CLR)
  34.   (if (=(tblobjname "LAYER" LAY) nil)
  35.     (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
  36.        '(6 . "CONTINUOUS")(cons 62 CLR)'(70 . 0)(cons 2 LAY)))
  37.     (entmod(subst(cons 62 CLR)(assoc 62(entget(tblobjname "LAYER" LAY)))(entget(tblobjname "LAYER" LAY))))
  38.    )
  39.    (setvar "CLAYER" LAY)
  40.   )
  41.   (setlayer_lsp "Q-铝板" 4);检查图层是否存在,没有则新建图层,颜色为4号色,即青色
  42.   (command "offset" "L" "C" "" "");;;设置偏移后的对象到当前层,即"Q-铝板"
  43.   
  44.     (setq dist (getdist (strcat "\n输入偏移距离:<"
  45.                               (rtos (getvar "OFFSETDIST")) ">")))
  46.   (if (null dist)
  47.     (setq dist (getvar "offsetdist"))
  48.     (setvar "offsetdist" dist)  )
  49. ;;;(while  ;;加循环
  50.   (setq en (car(entsel "\n请选择线:")))
  51.   (setvar "cmdecho" 1)
  52. (command "offset" dist en  pause "")
  53. (setvar "cmdecho" 0)
  54. (setq en1 (entlast))
  55. (setq p1(vlax-curve-getstartpoint en)
  56.          p2(vlax-curve-getendpoint en)
  57.          p3(vlax-curve-getstartpoint en1)
  58.          p4(vlax-curve-getendpoint en1))  
  59. (command ".line" p1 p3 ""  ".line" p2 p4 "")

  60. (command "pedit" en1 "j" "all" "" "");;以偏移后的对象所在层连接所有线
  61. (setq en2 (entlast))
  62. (command "CHPROP" en2 "" "C" "BYLAYER" "LT" "BYLAYER" "S" "1"  "LW" "BYLAYER" "" );;恢复颜色随层
  63. (command ".-hatch" "p" "ansi31" "1" "0" "s" en2 "" "");;;若不需要填充,可删除此行
  64. ;;;)
  65. ;;;>>>>>>>>>>>>>
  66.   (vla-EndUndoMark      
  67.     (vla-get-ActiveDocument (vlax-get-acad-object))
  68.   )
  69.   (if *error*_Old (setq *error* *error*_Old))
  70.   (gc);;强制收回废内存
  71. ;;;>>>>>>>>>>>>
  72. (setvar "osmode" snap_old)
  73. (setvar "clayer" lay_old)
  74.   (princ)
  75. )

评分

参与人数 2明经币 +1 金钱 +5 收起 理由
1205这样时代 + 5 很给力!
纳铭m + 1 赞一个!

查看全部评分

 楼主| 发表于 2016-7-27 09:11 | 显示全部楼层
我就是做铝单板的,所以想用一些插件
发表于 2022-12-5 18:51 | 显示全部楼层
暂时用不上,收藏下
发表于 2022-12-5 20:35 | 显示全部楼层
路过,顶过,支持
发表于 2023-11-14 16:48 | 显示全部楼层

路过,顶过,支持
发表于 2024-2-20 14:01 | 显示全部楼层
支持一下;‘‘’’
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 02:44 , Processed in 0.221693 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表