[求助]：请高手解决等分点一次连成线的程序

PFD8667

如图1所示,每次要连成上百个点很麻烦,请高手帮编个程,能一次或分上下二次就形成如图2所示,先谢谢了!

舟自横

这个程序比较简单,你可以自己考虑一下
想问一下你的线是不是一条复线?如果是
给你个编程思路:
1...取得所有顶点做成一个列表
2...按奇偶数分为两个列表
3...把两个列表的点串起来就好了,
如果你的线有可能是分开的可以在
程序前面补一个判断程序:
  1....点选第一条线判断是否是复线.
2..如果是就直接进入上面所说的程序如果不时可以根据端点相关性将所有
线串为复线..然后进入程序..
你可以自己先动一下脑和手写一下,不难的..
写程序也就这样..多想多写就会熟的......
不知道我说的你明不明白.现帮你随便写了一下不知道
能不能符合你的要求...
(defun c:linkline(/ en lisp 13list i 24list )
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(WHILE (not(setq en (car(entsel "\n請選擇一段線"))))
(setq en (car(entsel "\n請選擇一段線"))))
(hy_apline en)
(setq lisp (hy_polpoint (entlast)))
(setq i 0)
(setq 13list '())
(setq 24list '())
(foreach item lisp (if i (progn (if (and (= (rem i 2) 0) (/= i 1))
(setq 13list (cons item 13list))
(setq 24list (cons item 24list))
)
(setq i (1+ i))
)
)
)
(command "pline")
(foreach item 13list (command item))
(command "")
(command "change" (entlast) "" "p" "color" "1" "")
(command "pline")
(foreach item 24list (command item))
(command "")
(command "change" (entlast) "" "p" "color" "1" "")
(princ "-------->> pline ok!! <<--------")
(prin1)
)
(defun hy_polpoint(object / endata i endata_li)
(setq point_list '())
(setq endata (entget object))
(setq i 0)
(while (< i (length endata))
(setq endata_li (nth i endata))
(if (= (car endata_li) 10) (setq point_list (cons (cdr endata_li) point_list)))
(setq i (1+ i))
)
(setq point_list (reverse point_list))
)
(defun hy_apline(ename1 / vla-obj endpoint ename startpoint i ss1 nn ssm ssn itemx);;;選擇一條線串接與之相聯的圖元為多義線
(if (= "LWPOLYLINE" (cdr(assoc 0 (entget ename1)))) (command "._explode" ename ""))
(setq ename (entlast))
(setq vla-obj (vlax-ename->vla-object ename))
(setq startpoint (vlax-curve-getstartpoint vla-obj)
endpoint (vlax-curve-getendpoint vla-obj))
;(safearray-value(vlax-variant-value(vla-get-endpoint vla-obj))))
(if (OR (= "POLYLINE" (cdr(assoc 0 (entget ename))))
(= "LWPOLYLINE" (cdr(assoc 0 (entget ename)))))
(setq i 1)(SETQ I 0))
(setq j 0);;計數器歸0
(setq nn 0)
(princ " ─── \r")
(while (> (distance startpoint endpoint) 0.0000001);(= (vla-get-closed vla-obj) :vlax-false)
;(setq ss1 (ssget "x" (list (cons -4 " (setq ss1 (ssadd))
(setq ssn (ssget "f" (list endpoint (polar endpoint 0.8 0.1))))
(foreach itemx (ap-sslist ssn)
(if (or (< (distance endpoint (vlax-curve-getstartpoint (vlax-ename->vla-object itemx))) 0.0000001)
(< (distance endpoint (vlax-curve-getendpoint (vlax-ename->vla-object itemx))) 0.0000001))
(setq ss1 (ssadd itemx ss1))
)
)
(setq ss2 (ssadd))
(setq ssm (ssget "f" (list startpoint (polar startpoint 0.8 0.1))))
(foreach itemx (ap-sslist ssm)
(if (or (< (distance startpoint (vlax-curve-getstartpoint (vlax-ename->vla-object itemx))) 0.0000001)
(< (distance startpoint (vlax-curve-getendpoint (vlax-ename->vla-object itemx))) 0.0000001))
(setq ss2 (ssadd itemx ss2))
)
)
(setq ssg (addss ss1 ss2))
(if (= 0 i)(command "pedit" ename "y" "j" ssg "" "")
(command "pedit" ename "j" ssg "" ""))
(setq ename (entlast))
(setq vla-obj (vlax-ename->vla-object ename))
(setq startpoint (vlax-curve-getstartpoint vla-obj)
endpoint (vlax-curve-getendpoint vla-obj))
(setq i (1+ i))
(setq nn (1+ nn))
(cond ((= nn 15)(princ (strcat "線很長..正在串接中,請稍侯 ...... ───" "\r")))
((= nn 30)(princ (strcat "線很長..正在串接中,請稍侯 ...... ﹨﹨﹨" "\r")))
((= nn 45)(princ (strcat "線很長..正在串接中,請稍侯 ...... │││" "\r")))
((= nn 60)(princ (strcat "線很長..正在串接中,請稍侯 ...... ∕∕∕" "\r")))
)
(if (> nn 60) (setq nn 1))
(setq j (1+ j))
(IF (and (= 1 (sslength ssg))(= (vla-get-closed vla-obj) :vlax-false))
(setq startpoint '(0 0 0) endpoint '(0 0 0)));(alert "\n請注意!****串接不線不能封閉!")
)
(if (> j 1000)(prompt (strcat "\n恭喜你一共把" (itoa (+ (* 2 j) 3)) "條線串接成了一個封閉的復線!")))
)
执行LINKLINE....

PFD8667

舟自横您好!
您的贴子,等于发了二次,我也没法出于礼貌,我也重复回贴了
谢谢您的帮助,不好意思我没讲清楚,我一点都不懂编程,
我要的这个程序已经有狂刀兄圆满的解决了.