;;;;;;;****************************偏移后两段封堵连线（一般用于铝板单线偏移）
;;;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:PT( / 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)
)
点评回复 支持 反对使用道具 评分 举报
15617556676

1

主题	
21

帖子	
23

明经币
注册会员

积分260注册时间2018-9-4最后登录2023-8-27
发消息
22#
 发表于 2018-9-5 08:33:33 | 只看该作