如何找一般线段的各顶点（附图）

lxqun

我要根据如图竖线与折线的交点（该交点可以通过拾取得到其坐标）分别往左右两边找折线的各顶点坐标，怎么搞？请帮帮忙！

ccy012

选中须查找的线段，输入“list“查看就行了

lxqun

要的是自动得出坐标啊，只要拾取那个交点后，就能得到左右两边的各个顶点，不用再在图上点了

meflying

你所谓的折线并不是折线，只是一些线段组成的。。。是否都这样？
还有，竖线是否都会在某个顶点上？

lxqun

对，就是这样。是一些线段的组成并且竖线肯定在某个顶点上。

meflying

2. 
   
3. (defun c:GetPt( / ent pt1 pt2 ss i ptL1 ptL2 pts)
   
4.   (setq ent (car (entsel "选择竖线...")))
   
5.   (setq pt1 (cdr (assoc 10 (entget ent))))
   
6.   (setq pt2 (cdr (assoc 11 (entget ent))))
   
7.   (setq ss (ssget "f" (list pt1 pt2) '((0 . "line"))))
   
8.   (ssdel ent ss)
   
9.   (setq i 0)
   
10.   (repeat (sslength ss)
    
11.     (setq ent (ssname ss i))
    
12.     (setq ptL1 (cdr (assoc 10 (entget ent))))
    
13.     (setq ptL2 (cdr (assoc 11 (entget ent))))
    
14.     (setq ptInter (inters pt1 pt2 ptL1 ptL2))
    
15.     (if (equal ptL1 ptInter 0.00001)
    
16.       (setq pts (append pts (list ptL2)))
    
17.       (setq pts (append pts (list ptL1)))
    
18.     )
    
19.     (setq i (1+ i))
    
20.   )
    
21.   pts
    
22. )
    
23.   

<br /> (defun c:GetPt( / ent pt1 pt2 ss i ptL1 ptL2 pts)<br />   (setq ent (car (entsel "选择竖线...")))<br />   (setq pt1 (cdr (assoc 10 (entget ent))))<br />   (setq pt2 (cdr (assoc 11 (entget ent))))<br />   (setq ss (ssget "f" (list pt1 pt2) '((0 . "line"))))<br />   (ssdel ent ss)<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i))<br />     (setq ptL1 (cdr (assoc 10 (entget ent))))<br />     (setq ptL2 (cdr (assoc 11 (entget ent))))<br />     (setq ptInter (inters pt1 pt2 ptL1 ptL2))<br />     (if (equal ptL1 ptInter 0.00001)<br />       (setq pts (append pts (list ptL2)))<br />       (setq pts (append pts (list ptL1)))<br />     )<br />     (setq i (1+ i))<br />   )<br />   pts<br /> )<br />   

lxqun

为什么只找到两个点啊，左边一个，右边一个，都是离交点最近的那个点。我需要的是所有线段的顶点啊？

meflying

2. 
   
3. (defun c:GetPt( / ss pt x i pt1 pt2 ptLs ptRs ent)
   
4.   (setq ss (ssget "x" '((0 . "line"))))
   
5.   (setq pt (cdr (assoc 10 (entget (car (entsel "选择竖线..."))))))
   
6.   (setq x (car pt))
   
7.   (setq i 0)
   
8.   (setq ptLs nil
   
9.         ptRs nil)
   
10.   (repeat (sslength ss)
    
11.     (setq ent (ssname ss i))
    
12.     (setq pt1 (cdr (assoc 10 (entget ent))))
    
13.    
    
14.     (cond
    
15.       ((< (car pt1) x) (if (not (member pt1 ptLs)) (setq ptLs (append ptLs (list pt1)))))
    
16.       ((> (car pt1) x) (if (not (member pt1 ptRs)) (setq ptRs (append ptRs (list pt1)))))
    
17.     )
    
18.     (setq pt2 (cdr (assoc 11 (entget ent))))
    
19.     (cond
    
20.       ((< (car pt2) x) (if (not (member pt2 ptLs)) (setq ptLs (append ptLs (list pt2)))))
    
21.       ((> (car pt2) x) (if (not (member pt2 ptRs)) (setq ptRs (append ptRs (list pt2)))))
    
22.     )
    
23.    
    
24.     (setq i (1+ i))
    
25.   )
    
26.   (list ptLs ptRs)
    
27. )
    

<br /> (defun c:GetPt( / ss pt x i pt1 pt2 ptLs ptRs ent)<br />   (setq ss (ssget "x" '((0 . "line"))))<br />   (setq pt (cdr (assoc 10 (entget (car (entsel "选择竖线..."))))))<br />   (setq x (car pt))<br />   (setq i 0)<br />   (setq ptLs nil<br />         ptRs nil)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i))<br />     (setq pt1 (cdr (assoc 10 (entget ent))))<br />     <br />     (cond<br />       ((< (car pt1) x) (if (not (member pt1 ptLs)) (setq ptLs (append ptLs (list pt1)))))<br />       ((> (car pt1) x) (if (not (member pt1 ptRs)) (setq ptRs (append ptRs (list pt1)))))<br />     )<br />     (setq pt2 (cdr (assoc 11 (entget ent))))<br />     (cond<br />       ((< (car pt2) x) (if (not (member pt2 ptLs)) (setq ptLs (append ptLs (list pt2)))))<br />       ((> (car pt2) x) (if (not (member pt2 ptRs)) (setq ptRs (append ptRs (list pt2)))))<br />     )<br />     <br />     (setq i (1+ i))<br />   )<br />   (list ptLs ptRs)<br /> )<br />

lxqun

ok了，谢谢

无痕

2. 
   
3. ;|pts=按分界点列左右直线点表并排序--------------------------------无痕.2004.1
   
4. 测试:
   
5. Command: pts
   
6. 选分界点:
   
7. -> (((10628.5 9484.92 0.0) (14627.4 13324.7 0.0) (16925.9 10523.5 0.0) (19602.4 12632.2 0.0))
   
8.     ((26214.7 9012.82 0.0) (27789.1 12474.9 0.0) (32354.8 9107.24 0.0) (37140.8 12065.7 0.0) (38085.5 10114.4 0.0)))
   
9. |;
   
10. [color=blue]
    
11. (defun c:pts ( / pt ss ssv ptlst1 ptlst2)
    
12.   (setq ptlst1 nil ptlst2 nil
    
13.         pt  (getpoint "\n选分界点:")
    
14.         ss  (ssget "x" '((0 . "LINE")))
    
15.         ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
    
16.   (vlax-for obj ssv
    
17.         (foreach n (list (vlax-get obj 'startpoint) (vlax-get obj 'endpoint))
    
18.            (cond  ((and (< (car n) (car pt))(not (member n ptlst1))) (setq ptlst1 (cons n ptlst1)))
    
19.                   ((and (> (car n) (car pt))(not (member n ptlst2))) (setq ptlst2 (cons n ptlst2)))
    
20.            )
    
21.   )   )
    
22.   (list (vl-sort ptlst1 (setq sortlst '(lambda (x y) (< (car x)(car y))))) (vl-sort ptlst2 sortlst))
    
23. )[/color]

<br /> ;|pts=按分界点列左右直线点表并排序--------------------------------无痕.2004.1<br /> 测试:<br /> Command: pts<br /> 选分界点:<br /> -> (((10628.5 9484.92 0.0) (14627.4 13324.7 0.0) (16925.9 10523.5 0.0) (19602.4 12632.2 0.0))<br />     ((26214.7 9012.82 0.0) (27789.1 12474.9 0.0) (32354.8 9107.24 0.0) (37140.8 12065.7 0.0) (38085.5 10114.4 0.0)))<br /> |;<br /> [color=blue]<br /> (defun c:pts ( / pt ss ssv ptlst1 ptlst2)<br />   (setq ptlst1 nil ptlst2 nil<br />         pt  (getpoint "\n选分界点:")<br />         ss  (ssget "x" '((0 . "LINE")))<br />         ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))<br />   (vlax-for obj ssv<br />         (foreach n (list (vlax-get obj 'startpoint) (vlax-get obj 'endpoint))<br />            (cond  ((and (< (car n) (car pt))(not (member n ptlst1))) (setq ptlst1 (cons n ptlst1)))<br />                   ((and (> (car n) (car pt))(not (member n ptlst2))) (setq ptlst2 (cons n ptlst2)))<br />            )<br />   )   )<br />   (list (vl-sort ptlst1 (setq sortlst '(lambda (x y) (< (car x)(car y))))) (vl-sort ptlst2 sortlst))<br /> )[/color]