渐进式同心圆
本帖最后由 荒野孤行 于 2013-12-28 22:20 编辑图片效果如下：
源码见附件。
来个图片演示啊，朋友！嘿嘿，这回怎么这么含蓄 tianyi1230 发表于 2013-12-13 22:42
来个图片演示啊，朋友！嘿嘿，这回怎么这么含蓄
没币了，赚点钱下载别人的源码，哈。 荒野孤行 发表于 2013-12-13 05:18 static/image/common/back.gif
没币了，赚点钱下载别人的源码，哈。
这类型的早有了吧 tianyi1230 发表于 2013-12-13 22:42 static/image/common/back.gif
来个图片演示啊，朋友！嘿嘿，这回怎么这么含蓄
已传图片演示。 ;; 圆动态渐变偏移变色
;;需要e派工具箱(XCAD)的支持：http://yunpan.cn/QXQKsW9gAPmpF(defun c:test1498 (/ s0 p0 rr mode mo co r0 i p1 dd s00 n ss)
(xyp-CMDLA0)
(setq d0 (Udist 1 "" "渐进距离<输入或鼠标直接量取>" d0 nil)
s0 (car (entsel "\n选择圆: "))
p0 (xyp-DXF 10 s0)
rr (xyp-DXF 40 s0)
mode t
)
(while mode
(setq mo (grread t 15 0)
co (car mo)
r0 0
)
(redraw)
(cond ((member co '(5))
(if (and ss (> (sslength ss) 0))
(xyp-erase ss)
)
(setq i 1
p1(cadr mo)
dd(distance p1 p0)
s00 (entlast)
)
(xyp-Grvecs-Ptlst (list p0 p1) 1)
(while (< (+ r0 rr) dd)
(setq n(* (/ (+ 1 i) 2.) i)
r0 (* n d0)
i(1+ i)
)
(xyp-Offset s0 r0 t nil nil)
(xyp-SubUpd (entlast) 62 (rem i 255))
)
(setq ss (xyp-SSelEntnext s00)
)
)
(t (setq mode nil))
)
)
(xyp-CMDLA1)
) 相当给力的程序啊 琴剑江山_10184 发表于 2015-1-8 08:10 static/image/common/back.gif
相当给力的程序啊
(defun c:t1 ()
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(princ "\n★功能：查找同心圆.")
(command "undo" "be")
(vl-load-com)
(while
(progn
(setq ent1 (entsel "\n请选择参照圆：\n"))
(not
(if (= ent1 nil)
nil
(wcmatch (cdr (assoc 0 (entget (car ent1))))
"CIRCLE"
) ;限定只能选取圆
)
)
)
)
(setq entnam1 (car ent1))
(setq circlecoord1 (cdr (assoc 10 (entget entnam1))))
(initget 4)
(if (not (setq wcz (getreal "请输入误差值：<0.00005>")))
(setq wcz 0.00005)
)
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
(progn
(setvar "osmode" 0)
(setq i 0)
(command "_.LAYER" "M" "层-同心圆" "C" "1" "层-同心圆" "")
(repeat (sslength ss)
(setq entnam2 (ssname ss i))
(setq entdata2 (entget entnam2))
(setq circlecoord2 (cdr (assoc 10 entdata2)))
(setq obj2 (vlax-ename->vla-object entnam2))
(if (equal circlecoord1 circlecoord2 wcz)
(vla-put-layer obj2 "层-同心圆")
)
(setq i (1+ i))
)
)
(princ "\n未选取到对象，程序退出.")
)
(command "undo" "e")
(setvar "osmode" 15359)
(princ)
)
页:
[1]