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

664571221 发表于 2019-10-21 10:59:26

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

本帖最后由迷失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:39

楼上的双向偏移错误

start4444 发表于 2019-10-22 11:16:53

(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:09

Thank for sharing ^^

页: [1]

明经CAD社区's Archiver

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