设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 求大神修改以下程序，偏移后的图形到当前图层
返回列表 发新帖
查看: 677|回复: 4

[提问] 求大神修改以下程序，偏移后的图形到当前图层

[复制链接]
664571221
发表于 2019-10-21 10:59 | 显示全部楼层 |阅读模式
;;批量偏移 By Gu_xl 2013.04.01
(defun c:py (/ CLOCKWISEP OFFSET KD SS N EN kd0)
  (defun CLOCKWISEP (en / lw minp MaxP lst)
    (setq lw (vlax-ename->vla-object en))
    (vla-GetBoundingBox lw 'MinP 'MaxP)
    (setq
      minp (vlax-safearray->list minp)
      MaxP (vlax-safearray->list MaxP)
      lst  (mapcar
             (function
               (lambda (x)
                 (vlax-curve-getParamAtPoint
                   lw
                   (vlax-curve-getClosestPointTo lw x)
                   )
                 )
               )
             (list minp
                   (list (car minp) (cadr MaxP))
                   MaxP
                   (list (car MaxP) (cadr minp))
                   )
             )
      )
    (if (or
          (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
          (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
          (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
          (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
          )
      t
      )
    )
  (initget 7 "W N S  ")
  (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))
  (if (= "" kd0)
    (setq kd0 "W")
    )
  (initget 6)
  (setq offset (getreal "\n[输入偏移距离]<0.5>"))
  (if (null offset)
    (setq offset 0.5)
    )
  (initget 7 "Y N  ")
  (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
  (if (= kd "")
    (setq kd "N")
    )
  (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))
    (repeat (setq n (sslength ss))
      (setq en (ssname ss (setq n (1- n))))
      (cond
        ((or (= "ARC" (cdr (assoc 0 (entget en))))
             (= "CIRCLE" (cdr (assoc 0 (entget en))))
             )
         (cond ((= kd0 "W")
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               ((= kd0 "N")
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               )
         )
        (t
         (cond ((= kd0 "W")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  (vla-offset (vlax-ename->vla-object en) offset)
                  )
                  (vla-put-Color (vlax-ename->vla-object (entlast)) 4)
                )
               ((= kd0 "N")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) offset)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  )
                  (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-Color (vlax-ename->vla-object (entlast)) 4)
                )
               )
         )
        )
      (if (= kd "Y")
        (entdel en)
        )
      )
    )
  (princ)
  )
回复

使用道具 举报

迷失2004
发表于 2019-10-21 16:59 | 显示全部楼层
本帖最后由 迷失2004 于 2019-10-21 19:08 编辑

试试是不是这样;;批量偏移 By Gu_xl 2013.04.01
(defun c:py (/ CLOCKWISEP OFFSET KD SS N EN kd0)
  (defun CLOCKWISEP (en / lw minp MaxP lst)
    (setq lw (vlax-ename->vla-object en))
    (vla-GetBoundingBox lw 'MinP 'MaxP)
    (setq
      minp (vlax-safearray->list minp)
      MaxP (vlax-safearray->list MaxP)
      lst  (mapcar
             (function
               (lambda (x)
                 (vlax-curve-getParamAtPoint
                   lw
                   (vlax-curve-getClosestPointTo lw x)
                   )
                 )
               )
             (list minp
                   (list (car minp) (cadr MaxP))
                   MaxP
                   (list (car MaxP) (cadr minp))
                   )
             )
      )
    (if (or
          (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
          (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
          (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
          (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
          )
      t
      )
    )
  (initget 7 "W N S  ")
  (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))
  (if (= "" kd0)
    (setq kd0 "W")
    )
  (initget 6)
  (setq offset (getreal "\n[输入偏移距离]<10>"));原来0.5 可能看不清 加到10 明显点
  (if (null offset)
    (setq offset 10)
    )
  (initget 7 "Y N  ")
  (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
  (if (= kd "")
    (setq kd "N")
    )
  (while (setq ss (ssget '((0 . "line,*polyline,arc,circle"))));这里加了直线也偏移
    (repeat (setq n (sslength ss))
      (setq en (ssname ss (setq n (1- n))))
      (cond
        ((or (= "ARC" (cdr (assoc 0 (entget en))))
             (= "CIRCLE" (cdr (assoc 0 (entget en))))
             )
         (cond ((= kd0 "W")
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
               (vla-put-Color (vlax-ename->vla-object (entlast)) 1);这行取消后颜色随层
                )
               ((= kd0 "N")
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;              (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;               (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;               (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               )
         )
        (t
         (cond ((= kd0 "W")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  (vla-offset (vlax-ename->vla-object en) offset)
                  )
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;                 (vla-put-Color (vlax-ename->vla-object (entlast)) 4)
                )
               ((= kd0 "N")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) offset)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  )
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;                 (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;               (vla-put-Color (vlax-ename->vla-object (entlast)) 1)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-Layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
;               (vla-put-Color (vlax-ename->vla-object (entlast)) 4)
                )
               )
         )
        )
      (if (= kd "Y")
        (entdel en)
        )
      )
    )
  (princ)
  )
回复 支持 反对

使用道具 举报

bai2000
发表于 2019-10-21 17:12 | 显示全部楼层
楼上的双向偏移错误
回复 支持 反对

使用道具 举报

start4444
发表于 2019-10-22 11:16 | 显示全部楼层
(defun c:tt5 (/ CLOCKWISEP OFFSET KD SS N EN kd0)
  (defun CLOCKWISEP (en / lw minp MaxP lst)
    (setq lw (vlax-ename->vla-object en))
    (vla-GetBoundingBox lw 'MinP 'MaxP)
    (setq
      minp (vlax-safearray->list minp)
      MaxP (vlax-safearray->list MaxP)
      lst  (mapcar
             (function
               (lambda (x)
                 (vlax-curve-getParamAtPoint
                   lw
                   (vlax-curve-getClosestPointTo lw x)
                   )
                 )
               )
             (list minp
                   (list (car minp) (cadr MaxP))
                   MaxP
                   (list (car MaxP) (cadr minp))
                   )
             )
      )
    (if (or
          (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
          (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
          (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
          (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
          )
      t
      )
    )
        (setq clayer (getvar "clayer"))
  (initget 7 "W N S  ")
  (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))
  (if (= "" kd0)
    (setq kd0 "W")
    )
  (initget 6)
  (setq offset (getreal "\n[输入偏移距离]<0.5>"))
  (if (null offset)
    (setq offset 0.5)
    )
  (initget 7 "Y N  ")
  (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
  (if (= kd "")
    (setq kd "N")
    )
  (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))
    (repeat (setq n (sslength ss))
      (setq en (ssname ss (setq n (1- n))))
      (cond
        ((or (= "ARC" (cdr (assoc 0 (entget en))))
             (= "CIRCLE" (cdr (assoc 0 (entget en))))
             )
         (cond ((= kd0 "W")
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                )
               ((= kd0 "N")
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                )
               )
         )
        (t
         (cond ((= kd0 "W")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  (vla-offset (vlax-ename->vla-object en) offset)
                  )
                  (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                )
               ((= kd0 "N")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) offset)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  )
                  (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                (vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
                )
               )
         )
        )
      (if (= kd "Y")
        (entdel en)
        )
      )
    )
  (princ)
  )
回复 支持 反对

使用道具 举报

ketxu
发表于 2019-10-26 10:39 | 显示全部楼层
Thank for sharing ^^
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-5-17 10:19 , Processed in 0.192911 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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