[求助]哪位高手请帮忙看看,做出这样一个程序

alex0007

这个问题最大的难度应该在于求最近距离上面了...算法对我来说太深..搞不来.

ZZXXQQ

2. (DEFUN C:TEST ()
3. (SETVAR "CMDECHO" 0)
4. (SETQ OLDOS (GETVAR "OSMODE"))
5. (PRINC "\nSelect a Block :")
6. (IF (SETQ SS (SSGET '((0 . "INSERT")))) (PROGN
7.   (SETQ BNM (ASSOC 2 (ENTGET (SSNAME SS 0)))
8. S1 (SSGET "X" (LIST '(0 . "INSERT") BNM)))
9.   (SETQ I -1 PTL (LIST))
10.   (REPEAT (SSLENGTH S1)
11.    (SETQ PTL (CONS (CDR (ASSOC 10 (ENTGET (SSNAME S1 (SETQ I (1+ I)))))) PTL))
12.   )
13.   (SETQ PTL (REVERSE PTL) I -1 TMP (LIST)
14. PT1 (LIST 0 0) PSL (LENGTH PTL))
15.   (WHILE (< I (- PSL 2))
16.    (SETQ J I DIS 1E8 K nil)
17.    (WHILE (< J (1- PSL))
18.     (SETQ PT2 (NTH (SETQ J (1+ J)) PTL) DS1 (DISTANCE PT2 PT1))
19.     (IF (< DS1 DIS) (SETQ DIS DS1 K J))
20.    )
21.    (IF K
22.     (SETQ PT (NTH (SETQ I (1+ I)) PTL) PT1 (NTH K PTL)
23.    PTL (SUBST (LIST 'AA) PT1 PTL)
24.    PTL (SUBST PT1 PT PTL)
25.    PTL (SUBST PT (LIST 'AA) PTL))
26.     (SETQ I (1+ I))
27.    )
28.   )
29.   (SETVAR "OSMODE" 0)
30.   (SETQ I 0)
31.   (COMMAND "PLINE" (NTH 0 PTL))
32.   (REPEAT PSL
33.    (SETQ PT (NTH (SETQ I (1+ I)) PTL))
34.    (COMMAND PT)
35.   )
36.   (COMMAND "")
37. ))
38. (SETVAR "OSMODE" OLDOS)
39. (SETVAR "CMDECHO" 1)
40. (PRINC)
41. )

复制代码

carrot1983

好东西。！！！！收藏

userzhl

非常感谢12楼的版主，这正是我所要的程序！

您可不可以再帮我看看这个问题：

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=61659

yuanquan222

z版大大，希望你能改变算法，能框选区域，只连线这个区域内的这个图块。

wudi

好像记的以前论坛此版块里有过相关的话题，有源码的，并且连完的线是多段线