直线偏移且删除原直线

指尖 · 发表于 2025-7-17 21:52:58

AI生成程序，欢迎大家下载使用。

快捷命令： PY

(defun c:PY (/ ss dist i ent obj)
(vl-load-com)
(setq dist 1.5) ; 设置默认偏移距离1.5mm^^1^^
(if (setq dist (getdist (strcat "\n输入总偏移距离<" (rtos dist) ">: ")))
(princ)
(setq dist 1.5) ; 用户回车时保持默认值^^1^^
)
(if (setq ss (ssget '((0 . "LINE")))) ; 连续选择直线^^2^^3^^
(progn
(setq i 0)
(repeat (sslength ss) ; 遍历选择集^^3^^4^^
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-offset obj (/ dist 2.0)) ; 正向偏移^^2^^5^^
(vla-offset obj (- (/ dist 2.0))) ; 反向偏移^^2^^5^^
(entdel ent) ; 删除原线^^6^^
(setq i (1+ i))
)
(princ (strcat "\n已完成 " (itoa i) " 条直线的双向偏移"))
)
(princ "\n未选择有效直线对象")
)
(princ)
)
(princ "\n快捷命令PY已加载，输入PY执行程序。")
(princ)

m809289064j · 发表于 2025-7-19 16:53:21

(defun c:ooi (/ ENT EYNS OSMOD P1 P2 SS)
  (defun *error* (msg)
(if       osmod
   (progn (setvar "osmode" osmod))
)
(princ)
  )
  (defun ss->lst (ss)
(vl-remove-if-not
   '(lambda (x) (= (type x) 'ENAME))
   (apply 'append (ssnamex ss))
)
  )
  (defun oop- (lit / DD ENT2 EYNS PD X ENT)
(setq eyns (getenv "offset-del"))
(setq dd (abs (getvar 'offsetdist)))
(or       (zerop dd)
      (foreach ENT lit
      (setq       x (vlax-ename->vla-object ENT)
            ent2 (entlast)
      )
      (setq       pd (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-offset (list X dd))
               )
      )
      (setq       pd (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-offset (list X (* -1 dd)))
               )
      )
      (or pd (and (= eyns "删除源对像") (vla-delete x)))
      (vlax-release-object x)
      )
)
(gc)
(prin1)
t
  )

  (princ "\n 双边偏移对像:")
  (or (getenv "offset-del")
   (setenv "offset-del" "保留源对像")
  )
  (setq osmod (getvar "osmode"))
  (while
(progn
   (setq eyns (getenv "offset-del"))
   (setvar 'errno 0)
   (setvar "osmode" 512)
   (initget 128)
   (setq p1
         (getpoint
            (strcat
               "\n双边偏移距离: "
               (rtos (* (abs (getvar 'OFFSETDIST)) 2) 2)
               " mm "
               eyns
               "”
选择对象:    或:
输入数字:偏移距离
输入字母:删除源对像
[删除(E)]"    )
         )
   )
   (setvar "osmode" osmod)
   (cond
      ((= 7 (getvar 'errno)) nil)
      ((= p1 nil) nil)
      ((= (type p1) 'list)
      (cond
         ((setq ent (nentselp p1)) (oop- (list (car ent))))
         ((and (setq p2 (getcorner p1)) (setq ss (ssget "c" p1 p2)))
         (oop- (ss->lst ss))
         )
      )
      )
      ((= p1 "u") (vl-cmdf "undo" "1"))
      ((and (= (type p1) 'str) (= (type (distof p1)) 'REAL))
      (setvar 'OFFSETDIST (/ (distof p1) 2))
      )
      ((and (= (type p1) 'str) (= eyns "删除源对像"))
      (setenv "offset-del" "保留源对像")
      )
      ((and (= (type p1) 'str) (= eyns "保留源对像"))
      (setenv "offset-del" "删除源对像")
      )
      (t nil)
   )
)
  )
  (gc)
  (prin1)
)

jt133 · 发表于 2025-7-18 10:21:29

在坛里找的轮子，根据自己的实际使用情况作了改造。不记得是哪位大佬的，勿怪。

(defun c:cx (/ date ss Newmove *move* obj e1 e2 i p1 p2 p3 p4 yn lay clay olay)
(defun *MYERR* (MSG)
(setvar "CMDECHO" CMD_OLD)
(setvar "OSMODE" OS_OLD)
(setvar "pickbox" pi_OLD)
(setq *ERROR* *OLDERR*)
(if (= MSG "完美退出。谢谢使用。")
(princ (strcat "\\n>>>" MSG))
(princ "\\n>>>虽然中途退出了，对象捕捉已经被恢复。")
)
(princ)
)
(vl-load-com)
(command "undo" "be");撤销命令,设置undo起点
(setq *OLDERR* *ERROR*
*ERROR* *MYERR*
OS_OLD (getvar "OSMODE")
CMD_OLD (getvar "CMDECHO")
pi_OLD (getvar "pickbox")
)
(setvar "osmode" 0)
(setvar "CMDECHO" 0)
(if *move*
(setq Newmove (getreal (strcat "\n请输入双线宽度:<" (rtos *move* 2 4) ">:")))
(setq Newmove (getreal "\n请输入双线宽度:"))
)
(if (null Newmove)
(setq Newmove *move*)
(setq *move* Newmove)
)
(setq ss (ssget '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline"))))
(initget "Y N ")
(setq yn (getkword "\n[封口<Y>/不封口<N>]<Y>:"))
;(if (= yn "")(setq yn "Y"))
(or yn (setq yn "Y"))
(setq i 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object(ssname ss i)) i (1+ i))
(vla-offset obj (* Newmove 0.5)) (setq e1 (entlast))
(vla-offset obj (- 0 (* Newmove 0.5))) (setq e2 (entlast))
(vla-erase obj);删除原线
(if (= yn "Y")
(progn
(setq lay (entget e1)
clay (cdr (assoc 8 lay))
olay (getvar "clayer"))
(setvar "clayer" clay)
(setq p1(vlax-curve-getstartpoint e1)
p2(vlax-curve-getendpoint e1)
p3(vlax-curve-getstartpoint e2)
p4(vlax-curve-getendpoint e2))
;(command ".pline" "non" p1 "non" p3 "" ".pline" "non" p2 "non" p4 "")
(command ".pline" p1 p3 "" ".pline" p2 p4 "")
(setvar "clayer" olay)
))
)
(princ
"\n*********双线**********青衫美酒 ***********"
)
(setvar "pickbox" pi_OLD)
(setvar "cmdecho" CMD_OLD)
(setvar "osmode" OS_OLD )
(command "undo" "e")
(princ)
)

(defun c:cx (/ date ss Newmove *move* obj e1 e2 i p1 p2 p3 p4 yn lay clay olay) 
(defun *MYERR* (MSG) 
(setvar "CMDECHO" CMD_OLD) 
(setvar "OSMODE" OS_OLD) 
(setvar "pickbox" pi_OLD) 
(setq *ERROR* *OLDERR*) 
(if (= MSG "完美退出。谢谢使用。") 
(princ (strcat "\\n>>>" MSG)) 
(princ "\\n>>>虽然中途退出了，对象捕捉已经被恢复。") 
) 
(princ) 
) 
(vl-load-com) 
(command "undo" "be");撤销命令,设置undo起点 
(setq *OLDERR* *ERROR* 
      *ERROR*  *MYERR* 
       OS_OLD   (getvar "OSMODE") 
       CMD_OLD  (getvar "CMDECHO") 
       pi_OLD   (getvar "pickbox")   
) 
(setvar "osmode"  0) 
(setvar "CMDECHO" 0) 
(if *move* 
    (setq Newmove (getreal (strcat  "\n请输入双线宽度:<" (rtos *move* 2 4) ">:"))) 
    (setq Newmove (getreal "\n请输入双线宽度:")) 
    ) 
    (if (null Newmove) 
        (setq Newmove *move*) 
        (setq *move* Newmove) 
        ) 
  (setq ss (ssget  '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline")))) 
  (initget "Y  N ") 
  (setq yn (getkword "\n[封口<Y>/不封口<N>]<Y>:")) 
  ;(if (= yn "")(setq yn "Y")) 
  (or yn (setq yn "Y")) 
  (setq i 0) 
  (repeat (sslength ss) 
          (setq obj (vlax-ename->vla-object(ssname ss i)) i (1+ i)) 
     (vla-offset obj (* Newmove 0.5)) (setq e1 (entlast)) 
     (vla-offset obj (- 0 (* Newmove 0.5))) (setq e2 (entlast)) 
     (vla-erase obj);删除原线 
   (if (= yn "Y") 
     (progn 
      (setq lay (entget  e1) 
           clay (cdr (assoc 8  lay)) 
           olay (getvar "clayer")) 
      (setvar "clayer" clay) 
     (setq p1(vlax-curve-getstartpoint e1) 
           p2(vlax-curve-getendpoint e1) 
           p3(vlax-curve-getstartpoint e2) 
           p4(vlax-curve-getendpoint e2)) 
;(command ".pline" "non" p1 "non" p3 ""  ".pline" "non" p2 "non" p4 "") 
(command ".pline"  p1  p3 ""  ".pline"  p2  p4 "") 
(setvar "clayer" olay) 
   )) 
) 
  (princ 
    "\n*********双线**********青衫美酒 ***********" 
  ) 
(setvar "pickbox" pi_OLD) 
(setvar "cmdecho" CMD_OLD) 
(setvar "osmode"  OS_OLD ) 
(command "undo" "e") 
(princ) 
)

437271963 · 发表于 2025-7-17 22:34:16

本帖最后由 437271963 于 2025-7-17 22:36 编辑

;;双向偏移曲线-这个程序基本上把有漏洞修补了，可以偏移所有曲线，内容都做了注释
(defun c:tes ( / &kw dis ent ent2 obj pd ss1 ss2 x)
(if (null dist) (setq dist 1.5));默认偏移距离
(if (setq dis (getdist (strcat "\n请输入偏移距离:<" (rtos dist ) ">")));手动输入
(setq dist dis);保留数据
(setq dis dist);默认数据
)
(princ "\n请选择曲线")
(if (setq &kw (ssget '((0 . "Arc,Circle,Ellipse,*Line"))));选择对象是圆弧，圆，椭圆+直线等曲线
(progn
(setq ss1 '())
(while (setq ent (ssname &kw 0)) (setq &kw (ssdel ent &kw) ss1 (cons ent ss1)) );先把所有的曲线提取->防止删除图元的时候出现错误
(setq ss2 '());记录偏移失败的图元
(while (setq ent (car ss1))
(setq ss1 (cdr ss1) obj (vlax-ename->vla-object ent) pd nil ent2 (entlast))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list obj dis)));偏移对象-防止错误停止程序
(setq pd t);如果偏移失败就准备记录
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list obj (* -1 dis))));偏移对象
(setq pd t);如果偏移失败就准备记录
)
(if pd;如果有偏移失败
(progn
(while (setq ent2 (entnext ent2)) (entdel ent2) );如果双向偏移失败，就清除已经偏移的对象
(setq ss2 (cons ent ss2));源对象就记录
)
(vla-delete obj);偏移成功就删除
)
);while
(if (car ss2);如果有偏移失败的图元
(progn
(setq &kw (ssadd));建立选择集
(mapcar '(lambda(x) (vl-catch-all-apply 'ssadd (list x &kw))) ss2)
(sssetfirst nil &kw);未偏移成功的对象选择显示
)
)
)
)
(princ)
)

;;双向偏移曲线-这个程序基本上把有漏洞修补了，可以偏移所有曲线，内容都做了注释 
(defun c:tes ( / &kw dis ent ent2 obj pd ss1 ss2 x) 
 (if (null dist) (setq dist 1.5));默认偏移距离 
 (if (setq dis (getdist (strcat "\n请输入偏移距离:<" (rtos dist ) ">")));手动输入 
  (setq dist dis);保留数据 
  (setq dis dist);默认数据 
 ) 
 (princ "\n请选择曲线") 
 (if (setq &kw (ssget '((0 . "Arc,Circle,Ellipse,*Line"))));选择对象是圆弧，圆，椭圆+直线等曲线 
  (progn 
   (setq ss1 '()) 
   (while (setq ent (ssname &kw 0)) (setq &kw (ssdel ent &kw) ss1 (cons ent ss1)) );先把所有的曲线提取->防止删除图元的时候出现错误 
   (setq ss2 '());记录偏移失败的图元 
   (while (setq ent (car ss1)) 
    (setq ss1 (cdr ss1) obj (vlax-ename->vla-object ent) pd nil ent2 (entlast)) 
    (if (vl-catch-all-error-p (vl-catch-all-apply  'vla-offset (list obj dis)));偏移对象-防止错误停止程序 
     (setq pd t);如果偏移失败就准备记录 
    ) 
    (if (vl-catch-all-error-p (vl-catch-all-apply  'vla-offset (list obj (* -1 dis))));偏移对象 
     (setq pd t);如果偏移失败就准备记录 
    ) 
    (if pd;如果有偏移失败 
     (progn 
      (while (setq ent2 (entnext ent2)) (entdel ent2) );如果双向偏移失败，就清除已经偏移的对象 
      (setq ss2 (cons ent ss2));源对象就记录 
     ) 
     (vla-delete obj);偏移成功就删除 
    ) 
   );while 
   (if (car ss2);如果有偏移失败的图元 
    (progn 
     (setq &kw (ssadd));建立选择集 
     (mapcar '(lambda(x) (vl-catch-all-apply  'ssadd (list x &kw))) ss2) 
     (sssetfirst nil &kw);未偏移成功的对象选择显示 
    ) 
   ) 
  ) 
 ) 
 (princ) 
)

qifeifei · 发表于 2025-7-17 22:04:06

非常感谢你的分享

xiao1984 · 发表于 2025-7-17 22:12:29

论坛里面偏移的程序太多了！

不一样地设计 · 发表于 2025-7-18 01:16:08

感谢分享

south · 发表于 2025-7-18 13:58:50

有没有选双线变单的，重叠的默认为同一条

amook147 · 发表于 2025-7-18 15:15:01

用了没效果偏移后原线没有被删除。。怎么回事

指尖 · 发表于 2025-7-18 21:07:28

amook147 发表于 2025-7-18 15:15
用了没效果偏移后原线没有被删除。。怎么回事

是不是CAD版本的问题，我的是2010版本

amook147 · 发表于 2025-7-19 08:35:16

指尖发表于 2025-7-18 21:07
是不是CAD版本的问题，我的是2010版本

我这是2020版的

账号		自动登录	找回密码
密码			注册

直线偏移且删除原直线

本帖子中包含更多资源

评分