双向偏移--学习while运用

hhh454

看了好多关于while运用的帖子，也看了好多别人写的代码，我理解，就是有东西给while，他就会一直循环下去，没有就结束了。
下面是连续单选双向偏移的源码，带偏移后的改变线的颜色，或者改变线的图层，

1. (defun c:tt()
   
2.   (vl-load-com)
   
3.   (princ "\n单选双向偏移")
   
4.   (setq os (getvar 'osmode))
   
5.   (setq cmd (getvar 'cmdecho))
   
6.   (mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
   
7.   (setq w (getreal "\n【偏移宽度】："))
   
8.   (while (setq enpline (car(entsel)))
   
9.          (setvar 'osmode 0)
   
10.          (vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
    
11.          (setq pline1 (entlast))
    
12.          (command "change" pline1  "" "p" "c" "2" "" )
    
13.          (vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
    
14.          (setq pline2 (entlast))
    
15.          (command "change" pline2  "" "p" "la" "ngc6"  "" )
    
16.    )
    
17. (mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))
    
18. (princ)
    
19. )

(defun c:tt()<br />   (vl-load-com)<br />   (princ "\n单选双向偏移")<br />   (setq os (getvar 'osmode))<br />   (setq cmd (getvar 'cmdecho))<br />   (mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))<br />   (setq w (getreal "\n【偏移宽度】："))<br />   (while (setq enpline (car(entsel)))<br />          (setvar 'osmode 0)<br />          (vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))<br />          (setq pline1 (entlast))<br />          (command "change" pline1  "" "p" "c" "2" "" )<br />          (vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))<br />          (setq pline2 (entlast))<br />          (command "change" pline2  "" "p" "la" "ngc6"  "" )<br />    )<br /> (mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))<br /> (princ)<br /> )

下面请教高手，怎么能够在没有线的情况下，边画pline边偏移，连续生成双线，
下面是图片说明：

hhh454

999999 发表于 2020-9-8 11:57
强大呀，谢谢谢各位大神的讨论

坚持学习，支持一下

KO你

忘记这是哪位大佬的了，发下你们对比下，个人觉得这个好点
快捷键  gb  批量偏移
(defun c:gb (/ 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[输入偏移距离]<50>"))
  (if (null offset)
    (setq offset 50)
    )
  (initget 7 "Y N  ")
  (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
  (if (= kd "")
    (setq kd "N")
    )
  (while (setq ss (ssget '((0 . "*polyline,arc,circle,line,SPLINE"))))
    (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)) 4)
                )
               (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)
                )
               )
         )
        (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)) 4)
                )
               (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)
  )

zj20190405

437271963 发表于 2016-10-13 22:39
双向偏移对象，并改变偏移后的颜色。可以批量偏移，也可以点选偏移。

感谢老大，增加了删除
(defun c:oo (/ &k1 &kw1 val)
  (vl-load-com)
;;;  (fy_ErrorInit (append '("cmdecho" 0)) 1 nil)
  (setq        ooffooff**
         (if (setq val (getreal        (strcat        "\n板厚["
                                        (if ooffooff**
                                          (rtos ooffooff**)
                                          "18"
                                        )
                                        "]"
                                )
                       )
             )
           val
           (if ooffooff**
             ooffooff**
             18
           )
         )
  )
  (setq &kw1 (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))
  (while (setq &k1 (ssname &kw1 0))
    (setq &kw1 (ssdel &k1 &kw1)
          &k1  (vlax-ename->vla-object &k1)
    )
    (if        (null (vl-catch-all-error-p
                (vl-catch-all-apply 'vla-offset (list &k1 ooffooff**))
              )
        )
      (vla-put-color (vlax-ename->vla-object (entlast)) 1)
    )
    (if        (null (vl-catch-all-error-p
                (vl-catch-all-apply 'vla-offset (list &k1 (- ooffooff**)))
              )
        )
      (vla-put-color (vlax-ename->vla-object (entlast)) 1)
    )
  )
  (if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))
    (vl-cmdf "_.ERASE" (ssget "p") "")
  )
  (princ)
;;;  (fy_ErrorEnd)
)

437271963

双向偏移对象，并改变偏移后的颜色。可以批量偏移，也可以点选偏移。

2. (defun c:tes ( / &k1 &kw1);点选或框选双向偏移对象;并改变颜色为红
   
3. (vl-load-com)
   
4. (princ "\n请选择要双向偏移的对象")
   
5. (while (setq &kw1(ssget ":S" '((0 . "*LINE,CIRCLE,ARC,HELIX,ELLIPSE"))))
   
6.   (while (setq &k1 (ssname &kw1 0))
   
7.    (setq &kw1 (ssdel &k1 &kw1) &k1 (vlax-ename->vla-object &k1))
   
8.    (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list &k1 2.0))))
   
9.     (vla-put-color (vlax-ename->vla-object (entlast)) 1)
   
10.    )
    
11.    (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list &k1 -2.0))))
    
12.     (vla-put-color (vlax-ename->vla-object (entlast)) 1)
    
13.    )
    
14.   )
    
15. )
    
16. (princ)
    
17. )

(defun c:tes ( / &k1 &kw1);点选或框选双向偏移对象;并改变颜色为红<br /> (vl-load-com)<br /> (princ "\n请选择要双向偏移的对象")<br /> (while (setq &kw1(ssget ":S" '((0 . "*LINE,CIRCLE,ARC,HELIX,ELLIPSE"))))<br />   (while (setq &k1 (ssname &kw1 0))<br />    (setq &kw1 (ssdel &k1 &kw1) &k1 (vlax-ename->vla-object &k1))<br />    (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list &k1 2.0))))<br />     (vla-put-color (vlax-ename->vla-object (entlast)) 1)<br />    )<br />    (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list &k1 -2.0))))<br />     (vla-put-color (vlax-ename->vla-object (entlast)) 1)<br />    )<br />   )<br /> )<br /> (princ)<br /> )

hhh454

437271963 发表于 2016-10-13 22:39
双向偏移对象，并改变偏移后的颜色。可以批量偏移，也可以点选偏移。

谢谢，我想要的功能是画完一条pline线，自动偏移，然后接着再画一条，再自动偏移，请看我第二个图片

写不完的日记

repeat 用这个怎么样？

USER2128

给你完整的代码：

2. (defun c:tt()
   
3.   (vl-load-com)
   
4.   (princ "\n单选双向偏移")
   
5.   (setq os (getvar 'osmode))
   
6.   (setq cmd (getvar 'cmdecho))
   
7.   (mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
   
8.   (or (setq w (getreal "\n【偏移宽度】/<10.0>："))
   
9.       (setq w 10.0)
   
10.       )
    
11.   (while (or (setq enpline (car(entsel"\n拾线偏移，回车则画线偏移:")))
    
12.        (and (setq pt1 (getpoint"\n开始绘制PL线的起点/<退出>."))
    
13.       (setq pt2 (getpoint pt1 "\n开始绘制PL线的第2点/<退出>."))
    
14.       (progn
    
15.         (setq L-en (entlast));先设置最后一次的图元为L-en
    
16.         (princ "\n继续绘制PL线，回车结束画线.")
    
17.         (command "_.pline" "_non" pt1 pt2)
    
18.         (while (>(getvar 'cmdactive)0)(command pause))
    
19.         (setq enpline (entnext L-en))
    
20.         );end progn
    
21.       );end and
    
22.        );end or
    
23. 
    
24. 
    
25.          (setvar 'osmode 0)
    
26.          (vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
    
27.          (setq pline1 (entlast))
    
28.          (command "change" pline1  "" "p" "c" "2" "" )
    
29.          (vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
    
30.          (setq pline2 (entlast))
    
31.          (command "change" pline2  "" "p" "la" "ngc6"  "" )
    
32. ;         (command "change" pline2  "" "p" "c" "2" "" )
    
33.    )
    
34. (mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))
    
35. (princ)
    
36. )
    

(defun c:tt()<br />   (vl-load-com)<br />   (princ "\n单选双向偏移")<br />   (setq os (getvar 'osmode))<br />   (setq cmd (getvar 'cmdecho))<br />   (mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))<br />   (or (setq w (getreal "\n【偏移宽度】/<10.0>："))<br />       (setq w 10.0)<br />       )<br />   (while (or (setq enpline (car(entsel"\n拾线偏移，回车则画线偏移:")))<br />        (and (setq pt1 (getpoint"\n开始绘制PL线的起点/<退出>."))<br />       (setq pt2 (getpoint pt1 "\n开始绘制PL线的第2点/<退出>."))<br />       (progn<br />         (setq L-en (entlast));先设置最后一次的图元为L-en<br />         (princ "\n继续绘制PL线，回车结束画线.")<br />         (command "_.pline" "_non" pt1 pt2)<br />         (while (>(getvar 'cmdactive)0)(command pause))<br />         (setq enpline (entnext L-en))<br />         );end progn<br />       );end and<br />        );end or<br /> <br /> <br />          (setvar 'osmode 0)<br />          (vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))<br />          (setq pline1 (entlast))<br />          (command "change" pline1  "" "p" "c" "2" "" )<br />          (vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))<br />          (setq pline2 (entlast))<br />          (command "change" pline2  "" "p" "la" "ngc6"  "" )<br /> ;         (command "change" pline2  "" "p" "c" "2" "" )<br />    )<br /> (mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))<br /> (princ)<br /> )<br />

my258

这很强悍

999999

强大呀，谢谢谢各位大神的讨论