批量内缩偏移，完全源码

荒野孤行

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

香田里浪人

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

荒野孤行

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

香田里浪人

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

zwwen

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

荒野孤行

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

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

香田里浪人

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

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

荒野孤行

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

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

hhh454

期待楼主的代码，学习

emk

来了必须支持，学习中