社区 › 编程申请 › 求批量偏移程序

龙吟小调 发表于 2013-3-31 00:18:31

求批量偏移程序

望高手帮忙编一个，明币不行，人民币支付也可以

Gu_xl 发表于 2013-3-31 00:18:32

;;批量偏移 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)
                )
               ((= kd0 "N")
                (vla-offset (vlax-ename->vla-object en) (- offset))
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                )
               )
         )
      (t
         (cond ((= kd0 "W")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  (vla-offset (vlax-ename->vla-object en) offset)
                  )
                )
               ((= kd0 "N")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) offset)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  )
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                )
               )

         )
      )
      (if (= kd "Y")
      (entdel en)
      )
      )
    )
(princ)
)

liuxu042 发表于 2013-4-1 08:39:58

可以联系我qq：379539186

Andyhon 发表于 2013-4-1 10:33:57

图元对象只有圆与矩形框 !?
看演示已有现成的程序,所求何来

simpleye 发表于 2013-4-1 12:07:53

GU_xl版主这人真好~~~~

龙吟小调 发表于 2013-4-1 13:05:26

Andyhon 发表于 2013-4-1 10:33 static/image/common/back.gif
图元对象只有圆与矩形框 !?
看演示已有现成的程序,所求何来

那是别人的东西，不肯与我分享，因为我也用到此插件，所以求程序

龙吟小调 发表于 2013-4-1 13:14:22

Gu_xl 发表于 2013-4-1 11:04 static/image/common/back.gif


谢谢G版，程序试用了下挺好的，不过在试用的过程中，发现有点小问题，不知能否麻烦G版忙我改进下，加个偏移后与原来的有颜色区分，望G版帮忙下

Gu_xl 发表于 2013-4-1 19:23:48

龙吟小调 发表于 2013-4-1 13:14
谢谢G版，程序试用了下挺好的，不过在试用的过程中，发现有点小问题，不知能否麻烦G版忙我改进下，加个偏 ...

这个很简单，希望你自己动手！

龙吟小调 发表于 2013-4-3 22:09:07

Gu_xl 发表于 2013-4-1 19:23 static/image/common/back.gif
这个很简单，希望你自己动手！

这几天生病了，没来，谢谢G版，悬赏分要怎么给你，我不会操作，希望指教

【KAIXIN】 发表于 2013-4-19 09:20:36

;;批量偏移 By Gu_xl 2013.04.01
(defun c:xx (/ 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)) 1)
                )
               ((= 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)) 1)
                )
               )

         )
      )
      (if (= kd "Y")
      (entdel en)
      )
      )
    )
(princ)
)

查看完整版本: 求批量偏移程序