[编程申请]：请大家帮忙解决一下这个问题

wb0815

;;BY龙龙仔(LUCAS)
;;这样会快一点
(defun C:GETPT_LAI (/ SS N P1 P2 PT_LIST PT_LIST1 LEN)
  (setq SS (ssget '((0 . "*POLYLINE"))))
  (if SS
    (progn
      (setq N 0
     LEN (sslength SS)
      )
      (repeat LEN
(setq PT_LIST (append PT_LIST (GETLISTOFPLINE (ssname SS N))))
(setq N (1+ N))
      )
      (setq
PT_LIST
  (vl-sort PT_LIST
    (function (lambda (P1 P2)
         (cond ((< (car P1) (car P2)) t)
        ((and (= (car P1) (car P2))
       (< (cadr P1) (cadr P2))
         )
         t
        )
        (t NIL)
         )
       )
    )
  )
      )
      (setq N 0
     LEN (- (length PT_LIST) 1)
      )
      (repeat LEN
(if (and (equal (nth N PT_LIST) (nth (1+ N) PT_LIST))
   (not (member (nth N PT_LIST) PT_LIST1))
     )
   (setq PT_LIST1 (append PT_LIST1 (list (nth N PT_LIST))))
)
(setq N (1+ N))
      )
      PT_LIST1
    )
  )
)


以上是龙斑竹给我写的一个程序，请大家根据这个帮我编一个程序
要求
1  线是3dpoly
2  当两条线相交的时候必须有相同的节点。
3  可以对多根线进行选择。
4  要在两条线没有交点的地方在交点处进行标注。
具体要求请看一下文件

meflying

4  要在两条线没有交点的地方在交点处进行标注。

没有交点哪儿来的交点处？

meflying

还有一个小问题，就是你自己的获得POLYLINE顶点的程序，是去掉Z坐标的，这样如果两条线并不相交，但从视觉上是相交的（就是高度不同），这样也算是相交吗？

wb0815

原来我说话这么不严密，可能是知识有限。
不能去掉Z坐标，不能视觉
应该节点高度相同

meflying

程序如下，你可以修改Mark函数来修改你想要的标注样子，参数为：
pts_r 正确的交点
pts_w 错误的交点

2. 
   
3. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
   
4.   (setq ax_ent_1 (vlax-ename->vla-object ent1)
   
5.         ax_ent_2 (vlax-ename->vla-object ent2)
   
6.   )
   
7.   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
   
8.   (setq intpoints (vlax-variant-value intpoints))
   
9.   (setq i 0)
   
10.   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
11.     (repeat (/ (+ 1
    
12.               (- (vlax-safearray-get-u-bound intpoints 1)
    
13.                  (vlax-safearray-get-l-bound intpoints 1)
    
14.               )
    
15.            )
    
16.            3
    
17.         )
    
18.       (setq points (append points (list (list
    
19.                       (vlax-safearray-get-element intpoints i)
    
20.                       (vlax-safearray-get-element intpoints (+ i 1))
    
21.                       (vlax-safearray-get-element intpoints (+ i 2))
    
22.                     )))
    
23.       )
    
24.       (setq i (+ 3 i))
    
25.     )
    
26.   )
    
27.   points
    
28. )
    
29. 
    
30. (defun GetAllInters(ss / ss n i j ent1 ent2 points)
    
31.   (setq n (sslength ss))
    
32.   (setq i 0 j 0)
    
33.   (while (< i n)
    
34.     (setq j (1+ i))
    
35.     (setq ent1 (ssname ss i))
    
36.     (while (< j n)
    
37.       (setq ent2 (ssname ss j))
    
38.       (setq points (append points (getinterpoint ent1 ent2)))
    
39.       (setq j (1+ j))
    
40.     )
    
41.     (setq i (1+ i))
    
42.   )
    
43.   points
    
44. )
    
45. 
    
46. (defun setcolor(sname color / sinf)
    
47.   (setq sinf (entget sname))
    
48.   (if (assoc 62 sinf)
    
49.     (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
    
50.     (setq sinf (append sinf (list (cons 62 color))))
    
51.   )
    
52.   (entmod sinf)
    
53. )
    
54. 
    
55. (defun GetListOfPline (EntityName / SSE_Pline N newEntityName LastList)
    
56.   (setq SSE_Pline (entget EntityName))
    
57.   (setq LastList nil)
    
58.   (if (= (cdr (ASSOC 0 SSE_Pline)) "POLYLINE")
    
59.     (PROGN
    
60.       (setq newEntityName (entnext EntityName))
    
61.       (while (= (cdr (assoc 0 (entget newEntityName))) "VERTEX")
    
62.         (setq
    
63.           LastList (append
    
64.                      LastList
    
65.                      (list (cdr (assoc 10 (entget newEntityName))))
    
66.                    )
    
67.         )
    
68.         (setq newEntityName (entnext newEntityName))
    
69.       )
    
70.     )
    
71.   )
    
72.   LastList
    
73. ) ;_defun
    
74. 
    
75. 
    
76. (defun Mark (pts_r pts_w / i)
    
77.   (setq i 0)
    
78.   (repeat (length pts_r)
    
79.     (command "_.circle" (nth i pts_r) 2.5)
    
80.     (setcolor (entlast) 1)
    
81.     (setq i (1+ i))
    
82.   )
    
83.   (setq i 0)
    
84.   (repeat (length pts_w)
    
85.     (command "_.circle" (nth i pts_w) 2.5)
    
86.     (setcolor (entlast) 2)
    
87.     (setq i (1+ i))
    
88.   )
    
89. )
    
90. 
    
91. (defun main( / ss n len pt_list pts_r pts_w i pt)
    
92.   (setq ss (ssget '((0 . "POLYLINE"))))
    
93.   (if SS
    
94.     (progn
    
95.       (setq N        0
    
96.             LEN        (sslength SS)
    
97.       )
    
98.       (repeat LEN
    
99.         (setq PT_LIST (append PT_LIST (GETLISTOFPLINE (ssname SS N))))
    
100.         (setq N (1+ N))
     
101.       )      
     
102.       (setq pts (getallinters ss))
     
103.       (setq n 0)
     
104.       (repeat (length pts)
     
105.         (setq pt (nth n pts))
     
106.         (if (>= (- (length pt_list) (length (vl-remove pt pt_list))) 2)
     
107.           (if (not (member pt Pts_r))
     
108.             (setq Pts_r (append Pts_r (list pt)))
     
109.           )
     
110.           (if (not (member pt pts_w))
     
111.             (setq Pts_W (append Pts_w (list pt)))
     
112.           )
     
113.         )
     
114.         (setq n (1+ n))
     
115.       )
     
116.       (Mark pts_r pts_w)
     
117.     )
     
118.   )
     
119.   (princ)  
     
120. )
     
121. (defun err (msg)
     
122.   (princ msg)
     
123.   (command "_.undo" "e")
     
124.   (setq *error* errtmp)
     
125.   (setvar "cmdecho" cmd)
     
126.   (setvar "osmode" os)
     
127.   (princ)
     
128. )
     
129. (defun c:getpt()
     
130.   (setq os (getvar "osmode"))
     
131.   (setq cmd (getvar "cmdecho"))
     
132.   (setvar "osmode" 0)
     
133.   (setvar "cmdecho" 0)
     
134.   (setq errtmp *error*)
     
135.   (setq *error* err)
     
136.   (command "_.undo" "be")
     
137.   (main)
     
138.   (command "_.undo" "e")
     
139.   (setq *error* errtmp)
     
140.   (setvar "cmdecho" cmd)
     
141.   (setvar "osmode" os)
     
142.   (princ)
     
143. )

<br /> (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)<br />   (setq ax_ent_1 (vlax-ename->vla-object ent1)<br />         ax_ent_2 (vlax-ename->vla-object ent2)<br />   )<br />   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<br />   (setq intpoints (vlax-variant-value intpoints))<br />   (setq i 0)<br />   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />     (repeat (/ (+ 1<br />               (- (vlax-safearray-get-u-bound intpoints 1)<br />                  (vlax-safearray-get-l-bound intpoints 1)<br />               )<br />            )<br />            3<br />         )<br />       (setq points (append points (list (list<br />                       (vlax-safearray-get-element intpoints i)<br />                       (vlax-safearray-get-element intpoints (+ i 1))<br />                       (vlax-safearray-get-element intpoints (+ i 2))<br />                     )))<br />       )<br />       (setq i (+ 3 i))<br />     )<br />   )<br />   points<br /> )<br /> <br /> (defun GetAllInters(ss / ss n i j ent1 ent2 points)<br />   (setq n (sslength ss))<br />   (setq i 0 j 0)<br />   (while (< i n)<br />     (setq j (1+ i))<br />     (setq ent1 (ssname ss i))<br />     (while (< j n)<br />       (setq ent2 (ssname ss j))<br />       (setq points (append points (getinterpoint ent1 ent2)))<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   points<br /> )<br /> <br /> (defun setcolor(sname color / sinf)<br />   (setq sinf (entget sname))<br />   (if (assoc 62 sinf)<br />     (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))<br />     (setq sinf (append sinf (list (cons 62 color))))<br />   )<br />   (entmod sinf)<br /> )<br /> <br /> (defun GetListOfPline (EntityName / SSE_Pline N newEntityName LastList)<br />   (setq SSE_Pline (entget EntityName))<br />   (setq LastList nil)<br />   (if (= (cdr (ASSOC 0 SSE_Pline)) "POLYLINE")<br />     (PROGN<br />       (setq newEntityName (entnext EntityName))<br />       (while (= (cdr (assoc 0 (entget newEntityName))) "VERTEX")<br />         (setq<br />           LastList (append<br />                      LastList<br />                      (list (cdr (assoc 10 (entget newEntityName))))<br />                    )<br />         )<br />         (setq newEntityName (entnext newEntityName))<br />       )<br />     )<br />   )<br />   LastList<br /> ) ;_defun<br /> <br /> <br /> (defun Mark (pts_r pts_w / i)<br />   (setq i 0)<br />   (repeat (length pts_r)<br />     (command "_.circle" (nth i pts_r) 2.5)<br />     (setcolor (entlast) 1)<br />     (setq i (1+ i))<br />   )<br />   (setq i 0)<br />   (repeat (length pts_w)<br />     (command "_.circle" (nth i pts_w) 2.5)<br />     (setcolor (entlast) 2)<br />     (setq i (1+ i))<br />   )<br /> )<br /> <br /> (defun main( / ss n len pt_list pts_r pts_w i pt)<br />   (setq ss (ssget '((0 . "POLYLINE"))))<br />   (if SS<br />     (progn<br />       (setq N        0<br />             LEN        (sslength SS)<br />       )<br />       (repeat LEN<br />         (setq PT_LIST (append PT_LIST (GETLISTOFPLINE (ssname SS N))))<br />         (setq N (1+ N))<br />       )      <br />       (setq pts (getallinters ss))<br />       (setq n 0)<br />       (repeat (length pts)<br />         (setq pt (nth n pts))<br />         (if (>= (- (length pt_list) (length (vl-remove pt pt_list))) 2)<br />           (if (not (member pt Pts_r))<br />             (setq Pts_r (append Pts_r (list pt)))<br />           )<br />           (if (not (member pt pts_w))<br />             (setq Pts_W (append Pts_w (list pt)))<br />           )<br />         )<br />         (setq n (1+ n))<br />       )<br />       (Mark pts_r pts_w)<br />     )<br />   )<br />   (princ)  <br /> )<br /> (defun err (msg)<br />   (princ msg)<br />   (command "_.undo" "e")<br />   (setq *error* errtmp)<br />   (setvar "cmdecho" cmd)<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> (defun c:getpt()<br />   (setq os (getvar "osmode"))<br />   (setq cmd (getvar "cmdecho"))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setq errtmp *error*)<br />   (setq *error* err)<br />   (command "_.undo" "be")<br />   (main)<br />   (command "_.undo" "e")<br />   (setq *error* errtmp)<br />   (setvar "cmdecho" cmd)<br />   (setvar "osmode" os)<br />   (princ)<br /> )

wb0815

感谢 meflying 斑竹的热心帮忙
谢谢您了
特献上鲜花一朵