vla点转为lisp点_从前写的一个检查悬挂点的LISP程序源码

(defun c:wcjc()

;;;主程序入口

;;;功能:自动清除悬挂点

;;;作者:冯焱

;;;修改日期:2006-4-7

;;;修改目的:修改算法,改为SSGET取对象

;;;时间关系,未对LWPOLYLINE做处理

(vl-load-com)

(setq stime(getvar "date"))

(princ "\n内蒙古地质测绘院 冯焱\n")

(setq sel(ssget  '((-4 . "

(-4 . "or>")) )

ce(getvar "cmdecho")

count(sslength sel)

dis(getreal "\n请输入搜索半径<0.002>:")

Ra(getreal "\n请输入标记圆的半径<2>:")

ProCount 1

os(getvar "osmode")

)

(if(> dis 0.1)

(progn

(princ "\n超出最大范围,将按最大值处理!\n")

(setq dis 0.1)

)

)

(if(= dis nil)

(setq dis 0.002)

);if

(if(= Ra nil)

(setq Ra 2)

);if

(setvar "osmode" 0);设捕捉模式为空

(princ "\n正在处理,请稍侯...\n")

(setq m 0)

(setvar "cmdecho" 0)

(command ".undo" "be")

(repeat count ;循环选择对象

(setq ent(ssname sel m)

ed(entget ent)

entType(cdr(assoc 0 ed))

);setq

(if(= entType "POLYLINE")

(plObject ent);代入子程序

(progn

(princ "\n您未被授权处理LWPOLYLINE线型的,请与作者联系!\n")

(princ)

)

);if

(setq m(1+ m))

);repeat

(setvar "osmode