跪求一LISP程序
在CAD中点一根线，而这根线所有连接的封闭图元，全部以填充变色的形式显视出来，点另一根就显视另一根所连接的图元，跪求了，谢谢大家啊， 有那位高手能帮我搞一个啊，小弟谢过了 <p>填充的时候要渐变色填充还是一种颜色填充?</p> <p>一种颜色</p> <p>但是点那根线的时候就就只有那根线所连接的图元变色，很清楚的分变出那根线上所接的东西</p> 1、文件 Function.fas 可于 http://e.ys168.com/?ls0201 上下载，主要是些通用函数打包 部分来源于明经与网络2、下载文件 Function.fas 后放于CAD搜索路径
(defun c:test (/ *ERROR* CP_ENAMECP_VLA HATCH_SS
H_COL H_LAYERI NEWENTLAST
OBJ OBJ_BOXOBJ_CP OBJ_PL
OBJ_TYPE OLDENTLASTOLDERROR TEST_ERROR
)
(defun test_error (test_error_msg)
(setq *error* olderror)
(del_old_hatch h_layer)
)
(defun del_old_hatch (layer / OLD_HAT_OBJ)
(setq old_hat_obj
(ssget "x" (list (cons 0 "Hatch") (cons 8 layer)))
)
(if old_hat_obj
(command "_ERASE" old_hat_obj "")
)
)
(setq h_col 3) ;_定义填充的颜色 1-红 2-黄 3-绿 4-青 5-蓝 6-品红 7-白
(setq h_layer "填充色20100715") ;_定义填充的图层
(vl-load-com)
(setq olderror *error*
*error* test_error)
(if (findfile "Function.fas")
(progn
(load "Function.fas")
(while (and (setq obj (car (entsel "\n选择多段线")))
(or (=
(setq obj_type (cdr (assoc 0 (entget obj))))
"POLYLINE"
)
(= obj_type "LWPOLYLINE")
)
)
(progn
(if (= nil (tblsearch "layer" h_layer))
(command "-layer" "new" h_layer "")
)
(del_old_hatch h_layer)
(setq obj_pl (PL_plist_xy_list obj))
(setq obj_pl (xyp1-delsame obj_pl))
(setq obj_box (getbox obj))
(command "_zoom" (car obj_box) (last obj_box))
(setq obj_cp (ssget "f" obj_pl '((0 . "*POLYLINE"))))
(if obj_cp
(progn
(if (ssmemb obj obj_cp)
(setq obj_cp (ssdel obj obj_cp))
)
(if (> (sslength obj_cp) 0)
(progn
(setq i -1)
(setq hatch_ss (ssadd))
(repeat (sslength obj_cp)
(setq
cp_vla (vlax-ename->vla-object
(setq
cp_ename (ssname obj_cp
(setq i (1+ i))
)
)
)
)
(if (vlax-curve-isClosed cp_vla)
(setq hatch_ss (ssadd cp_ename hatch_ss))
)
)
(if (> (sslength hatch_ss) 0)
(progn
(setq oldentlast (entlast))
(command "_hatch" "SOLID" hatch_ss "")
(setq newentlast (entlast))
(if (equal oldentlast newentlast)
(progn
(alert "\n特殊原因无法填充")
)
(progn
(command "_change" newentlast "" "_p" "_color" h_col
"")
(command "_change" newentlast "" "_p" "_layer" h_layer
"")
)
)
)
)
)
)
)
)
(command "_zoom" "_p")
)
)
)
(progn
(alert "\n搜索目录没有找到文件 Function.fas")
)
)
(setq *error* olderror)
(del_old_hatch h_layer)
(princ)
)
谢谢兄弟啊。在下感激不尽 兄弟，怎么用不了啊 拜托再次指导一下 <p>怎么个用不了?</p>
<p>1、文件 <font face="Verdana">Function.fas</font> 可于 <font face="Verdana"><a href="http://e.ys168.com/?ls0201">http://e.ys168.com/?ls0201</a></font> 上下载，主要是些通用函数打包 部分来源于明经与网络</p>
<p>2、下载文件 <font face="Verdana">Function.fas</font> 后放于CAD搜索路径</p> <font face="Verdana">Function.fas</font> 文件放在搜索路径了?