源码无聊贴:xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9
本帖最后由 狂刀lxx 于 2011-5-10 23:34 编辑请留意演示，有多分支选择gong neng
以下是源码，纯无聊抛砖引玉，有要修改完善者勿扰
;| xj(连接首尾相连线条成封闭多义线) --by 狂刀 2007.9
说明: 方式:单点一条,自动搜索，多分支提示.
|;
(defun c:xj (/ E ESS FIL OS P1 PA PX0 PX1 ROOP SS SS2 SSS SSS2 X ee)
(princ "\n 连接首尾相连线条成封闭多义线------by 狂刀 2007.9")
(command ".undo" "be")
(setq fil '((0 . "LINE,ARC,*POLYLINE"))
os (getvar "osmode")
pa (getvar "PEDITACCEPT")
ssend(ssadd))
(setvar "osmode" 0)
(setvar "PEDITACCEPT" 1)
;; 生成首尾相连选集.
(while (and (princ "\n 选形成多义线的其中一条边线 <退出>:")
(setq ss (ssget ":S" fil))
)
(setq sss (ssadd)
sss2(ssadd)
roop nil)
(setq e (ssname ss 0)
e0 e
p0 (vlax-curve-getstartpoint e)
p1(vlax-curve-getendpoint e))
(vlax-put (vlax-ename->vla-object e) 'color 1)
(ssadd e sss)
(subxj ee p0)
(subxj ee p1)
(command ".pedit" "m" sss "" "j" 0.01"")
(setq ee (entlast))
(redraw ee 3)
;(vlax-put (vlax-ename->vla-object ee) 'color 3)
(ssadd ee ssend)
)
(mapcar '(lambda(x)(redraw x 4))(xss2lst ssend))
(setvar "PEDITACCEPT" pa)
(setvar "osmode" os)
(command ".undo" "e")
(princ)
)
;;
(defun subxj (EE p1 / PX0 PX1 ROOP X esss ess)
(setq e ee)
(while (and (setq ss2 (ssget "c" p1 p1 fil))
(not rooP)
)
(setq ess (xss2lst ss2)
esss(xss2lst sss))
(mapcar'(lambda(x)(setq ess(vl-remove x ess))) esss)
(if (not (member e0 ess))
(if (and ess (< 1 (length ess)))
(progn (mapcar '(lambda (x) (redraw x 3)) ess)
(setq e (car (entsel "\n 选择分支:")))
(mapcar '(lambda (x) (redraw x 4)) ess)
)
(setq e (car ess))
)
)
(if (and e (not (ssmemb e sss)))
(progn
(ssadd e sss)
(vlax-put (vlax-ename->vla-object e) 'color 1)
(setq px0 (vlax-curve-getstartpoint e)
px1 (vlax-curve-getendpoint e)
)
(if (equal p1 px0 1e-4)
(setq p1 px1)
(setq p1 px0)
)
)
(setq roop T)
)
)
)
;; 配套函数, 提取选集实体名列表.
(defun xss2lst (ss / i e lst)
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq lst (cons e lst))
)
(reverse lst)
)
1006882982 发表于 2012-6-26 03:27
(defun c:pp()
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
感谢分享~
单线或多线转多段线~ 這個功能效率很高，謝謝樓主分享 謝謝分享 狂刀无聊出品都这么帮，希望你天天都无聊，呵呵，谢谢分享 谢谢楼主的分享
收藏了,下来学习领会
谢谢 收藏备用，呵呵 no function definition: VLAX-CURVE-GETSTARTPOINT 收藏备用 备用！正在收集这方面的资料做水力计算！ 谢谢分享。程序利用点的方式获取物体进行组建多义线。 狂刀的程序，一定要收藏！ 希望你天天都无聊，呵呵 正缺这功能呢