[求助][1228]给线段编号编程方法

tctabc

[求助][1228]给线段编号编程方法

在使用vertexs 函数可以将线段顶点编号产生
但若为若干的线段非多义线时该如何处理呢?
以及如何改写才可自动判断多义线顶点数量而自动产生编号呢?

3. vertexs 函数
4. (defun vertexs (ename / plist pp n)
5. (setq obj (vlax-ename->vla-object ename))
6. (setq plist (vlax-safearray->list
7. (vlax-variant-value
8. (vla-get-coordinates obj)
9. ) )
10. )
11. (setq n 0)
12. (repeat (/ (length plist) 2)
13. (setq pp (append
14. pp
15. (list (list (nth n plist) (nth (1+ n) plist) ) ) )
16. )
17. (setq n (+ n 2))
18. )
19. pp
20. )

vertexs 函数 (defun vertexs (ename / plist pp n) (setq obj (vlax-ename->vla-object ename)) (setq plist (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj) ) ) ) (setq n 0) (repeat (/ (length plist) 2) (setq pp (append pp (list (list (nth n plist) (nth (1+ n) plist) ) ) ) ) (setq n (+ n 2)) ) pp )

4. 多义线顶点编号产生
5. (defun c:ts ( / polygon pt1 pt2 pt3 pt4 pt5 pt6 ptlist str1 str2 str3
7. str4 str5 str6)
9. (setq ptlist (vertexs (car (setq polygon (entsel "\n请点选物件:")))))
10. (setq   pt1 (nth 0 ptlist)
11.         pt2 (nth 1 ptlist)
12.         pt3 (nth 2 ptlist)
13.         pt4 (nth 3 ptlist)
14.         pt5 (nth 4 ptlist)
15.         pt6 (nth 5 ptlist)
16. )
18. (setq str1 (strcat "PT1:X=" (rtos (car pt1) 2 4) ", Y=" (rtos (cadr
20. pt1) 2 4)))
21. (setq str2 (strcat "PT2:X=" (rtos (car pt2) 2 4) ", Y=" (rtos (cadr
23. pt2) 2 4)))
24. (setq str3 (strcat "PT3:X=" (rtos (car pt3) 2 4) ", Y=" (rtos (cadr
26. pt3) 2 4)))
27. (setq str4 (strcat "PT4:X=" (rtos (car pt4) 2 4) ", Y=" (rtos (cadr
29. pt4) 2 4)))
30. (setq str5 (strcat "PT5:X=" (rtos (car pt5) 2 4) ", Y=" (rtos (cadr
32. pt5) 2 4)))
33. (setq str6 (strcat "PT6:X=" (rtos (car pt6) 2 4) ", Y=" (rtos (cadr
35. pt6) 2 4)))
37. (command "text" "j" "tl" pt1 "3" "0" str1)
38. (command "text" "j" "tl" pt2 "3" "0" str2)
39. (command "text" "j" "tl" pt3 "3" "0" str3)
40. (command "text" "j" "tl" pt4 "3" "0" str4)
41. (command "text" "j" "tl" pt5 "3" "0" str5)
42. (command "text" "j" "tl" pt6 "3" "0" str6)
44. (prin1))
47. (defun vertexs (ename / plist pp n)
48.   (setq obj (vlax-ename->vla-object ename))
49.   (setq plist (vlax-safearray->list
50.               (vlax-variant-value
51.               (vla-get-coordinates obj)
52.               ) )
53.   )
54.   (setq n 0)
55.   (repeat (/ (length plist) 2)
56.   (setq pp (append
57.            pp
58.            (list (list (nth n plist) (nth (1+ n) plist) ) ) )
59.            )
60.   (setq n (+ n 2))
61.   )
62.   pp
63. )

多义线顶点编号产生 (defun c:ts ( / polygon pt1 pt2 pt3 pt4 pt5 pt6 ptlist str1 str2 str3 str4 str5 str6) (setq ptlist (vertexs (car (setq polygon (entsel "\n请点选物件:"))))) (setq   pt1 (nth 0 ptlist)         pt2 (nth 1 ptlist)         pt3 (nth 2 ptlist)         pt4 (nth 3 ptlist)         pt5 (nth 4 ptlist)         pt6 (nth 5 ptlist) ) (setq str1 (strcat "PT1:X=" (rtos (car pt1) 2 4) ", Y=" (rtos (cadr pt1) 2 4))) (setq str2 (strcat "PT2:X=" (rtos (car pt2) 2 4) ", Y=" (rtos (cadr pt2) 2 4))) (setq str3 (strcat "PT3:X=" (rtos (car pt3) 2 4) ", Y=" (rtos (cadr pt3) 2 4))) (setq str4 (strcat "PT4:X=" (rtos (car pt4) 2 4) ", Y=" (rtos (cadr pt4) 2 4))) (setq str5 (strcat "PT5:X=" (rtos (car pt5) 2 4) ", Y=" (rtos (cadr pt5) 2 4))) (setq str6 (strcat "PT6:X=" (rtos (car pt6) 2 4) ", Y=" (rtos (cadr pt6) 2 4))) (command "text" "j" "tl" pt1 "3" "0" str1) (command "text" "j" "tl" pt2 "3" "0" str2) (command "text" "j" "tl" pt3 "3" "0" str3) (command "text" "j" "tl" pt4 "3" "0" str4) (command "text" "j" "tl" pt5 "3" "0" str5) (command "text" "j" "tl" pt6 "3" "0" str6) (prin1)) (defun vertexs (ename / plist pp n)   (setq obj (vlax-ename->vla-object ename))   (setq plist (vlax-safearray->list               (vlax-variant-value               (vla-get-coordinates obj)               ) )   )   (setq n 0)   (repeat (/ (length plist) 2)   (setq pp (append            pp            (list (list (nth n plist) (nth (1+ n) plist) ) ) )            )   (setq n (+ n 2))   )   pp )