双向偏移--学习while运用
本帖最后由 hhh454 于 2016-10-14 00:49 编辑看了好多关于while运用的帖子，也看了好多别人写的代码，我理解，就是有东西给while，他就会一直循环下去，没有就结束了。
下面是连续单选双向偏移的源码，带偏移后的改变线的颜色，或者改变线的图层，
(defun c:tt()
(vl-load-com)
(princ "\n单选双向偏移")
(setq os (getvar 'osmode))
(setq cmd (getvar 'cmdecho))
(mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
(setq w (getreal "\n【偏移宽度】："))
(while (setq enpline (car(entsel)))
(setvar 'osmode 0)
(vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
(setq pline1 (entlast))
(command "change" pline1"" "p" "c" "2" "" )
(vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
(setq pline2 (entlast))
(command "change" pline2"" "p" "la" "ngc6""" )
)
(mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))
(princ)
)
下面请教高手，怎么能够在没有线的情况下，边画pline边偏移，连续生成双线，
下面是图片说明：
999999 发表于 2020-9-8 11:57
强大呀，谢谢谢各位大神的讨论
坚持学习，支持一下 忘记这是哪位大佬的了，发下你们对比下，个人觉得这个好点
快捷键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)
) 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)
) 双向偏移对象，并改变偏移后的颜色。可以批量偏移，也可以点选偏移。(defun c:tes ( / &k1 &kw1);点选或框选双向偏移对象;并改变颜色为红
(vl-load-com)
(princ "\n请选择要双向偏移的对象")
(while (setq &kw1(ssget ":S" '((0 . "*LINE,CIRCLE,ARC,HELIX,ELLIPSE"))))
(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 2.0))))
(vla-put-color (vlax-ename->vla-object (entlast)) 1)
)
(if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list &k1 -2.0))))
(vla-put-color (vlax-ename->vla-object (entlast)) 1)
)
)
)
(princ)
)
437271963 发表于 2016-10-13 22:39
双向偏移对象，并改变偏移后的颜色。可以批量偏移，也可以点选偏移。
谢谢，我想要的功能是画完一条pline线，自动偏移，然后接着再画一条，再自动偏移，请看我第二个图片 repeat 用这个怎么样？ 给你完整的代码：
(defun c:tt()
(vl-load-com)
(princ "\n单选双向偏移")
(setq os (getvar 'osmode))
(setq cmd (getvar 'cmdecho))
(mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
(or (setq w (getreal "\n【偏移宽度】/<10.0>："))
(setq w 10.0)
)
(while (or (setq enpline (car(entsel"\n拾线偏移，回车则画线偏移:")))
(and (setq pt1 (getpoint"\n开始绘制PL线的起点/<退出>."))
(setq pt2 (getpoint pt1 "\n开始绘制PL线的第2点/<退出>."))
(progn
(setq L-en (entlast));先设置最后一次的图元为L-en
(princ "\n继续绘制PL线，回车结束画线.")
(command "_.pline" "_non" pt1 pt2)
(while (>(getvar 'cmdactive)0)(command pause))
(setq enpline (entnext L-en))
);end progn
);end and
);end or
(setvar 'osmode 0)
(vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
(setq pline1 (entlast))
(command "change" pline1"" "p" "c" "2" "" )
(vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
(setq pline2 (entlast))
(command "change" pline2"" "p" "la" "ngc6""" )
; (command "change" pline2"" "p" "c" "2" "" )
)
(mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))
(princ)
)
这很强悍 强大呀，谢谢谢各位大神的讨论
页:
[1]
2