批量内缩偏移，完全源码

荒野孤行 发表于 2013-10-28 00:34:50

本帖最后由荒野孤行于 2015-4-11 19:22 编辑

见附件。
说明：如果偏移后的曲线长度与原始长度相等，则将原始长度移动到“标记层”
图片效果如下：

香田里浪人 发表于 2013-10-31 05:53:49

;;批量偏移 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)
)

荒野孤行 发表于 2013-10-28 00:37:23

不好意思，请大家自己把lsp文件里面的(timeset)删掉，这样就可以用了。

香田里浪人 发表于 2013-10-28 06:23:05

能内缩偏移就能外扩偏移，如何修改？

zwwen 发表于 2013-10-28 11:34:54

输入内偏数字时，光标位置导致输入数字出错。
把(setq dist (getdist "\n输入要内缩偏移的距离<0.004>? "))改为(setq dist (getdist "\n输入要内缩偏移的距离<0.004>?"))即可。删除多余的空格。

荒野孤行 发表于 2013-10-29 23:53:27

香田里浪人发表于 2013-10-28 06:23 static/image/common/back.gif
能内缩偏移就能外扩偏移，如何修改？

大于号改小于号，小于号改大于号。外扩有很多中方法做，还有其它方法，内缩只是这种判断比较方便。

香田里浪人 发表于 2013-10-30 13:14:08

荒野孤行发表于 2013-10-29 23:53 static/image/common/back.gif
大于号改小于号，小于号改大于号。外扩有很多中方法做，还有其它方法，内缩只是这种判断比较方便。

大于号改小于号，小于号改大于号。试了一下，无法运行。

荒野孤行 发表于 2013-10-30 18:50:09

香田里浪人发表于 2013-10-30 13:14 static/image/common/back.gif
大于号改小于号，小于号改大于号。试了一下，无法运行。

当然还要改其它的一些参数了。稍后我发外扩偏移的。

hhh454 发表于 2013-10-31 01:43:14

期待楼主的代码，学习

emk 发表于 2013-10-31 07:10:58

来了必须支持，学习中

页: [1] 2 3

明经CAD社区's Archiver

批量内缩偏移，完全源码