检测多段线的起点和终点是否在其个直线上

远方小山

各位大神
           小弟想编个程序，用于检测任一条多段线的起始点是否在其他多段线上，其实也不用精确在，只要小于0.5就算在了，如果不在其他直线上，就在这个点的位置画个圆，请都各位大神，应该怎么编，跪求~~

远方小山

自己顶下贴

xinrstar

用这个函数
返回曲线上离指定点最近的点（在 WCS 上）
(vlax-curve-getClosestPointTo curve-obj givenPnt [extend])

kozmosovia

以多义线端点为中心，边长为1的正方形区域内ssget cp，根据选择集内多义线数量判断

远方小山

kozmosovia 发表于 2016-3-6 12:17
以多义线端点为中心，边长为1的正方形区域内ssget cp，根据选择集内多义线数量判断

这个方法我试过，但是效果不好，里面好多点在其他多段线上，也被检测出来，附代码如下，请大神指教。
(defun c:ckcn()
;;;关闭呼应
        (setvar "cmdecho" 0 )
        ;;;设置检测精度
        (setq jd (getdist "\n 输入检测精度<1.0>"))
        (if (null jd) (setq jd 1.0))
        (setq jd1 (getdist "\n 输入筛选精度<80>"))
        (if (null jd1) (setq jd 80))
        (setq dia (getdist "\n 输出存在问题点提示圆的直径<100>"))
        (if (null dia) (setq dia 100))
;;;新建问题图层
         (if (null (tblsearch "layer" "connectproblem"))
      (command "-layer" "m" "connectproblem" "c" 6 "" "")
      (command "-layer" "Thaw" "connectproblem" "ON" "connectproblem" "Set" "connectproblem" "Unlock" "connectproblem"  "")
  )
  ;;;构造选集
        (setq sspl (ssget '( ( 0 . "*lwpolyline"))))
        ;;;选择集转元素名表
        (setq sspln (ss->enamelst sspl))
        ;;;每个要素执行以下操作
        (foreach plname sspln
        (setq pt (mdxf 10 (entget plname)))
        (setq ft (numlist 1 pt) lt (numlist (length pt) pt))
        (cn plname ft jd  jd1 dia )
        (cn plname lt jd  jd1 dia )
        )
        (prin1)
)

(defun cn(plname  pt  jd jd1  dia / px1 px2 px3 px4 py1 py2 py3 py4 p1 p2 p3 p4 )
        (setq px (car pt) py (cadr pt))  
        (setq px1 (- px (/ jd 2))
                px2 (- px (/ jd 2) )
                px3 (+ px (/ jd 2) )
                px4 (+ px (/ jd 2) ))
        (setq py1 (+ py (/ jd 2))
                py2 (- py (/ jd 2) )
                py3 (- py (/ jd 2) )
                py4 (+ py (/ jd 2) ))        
               
        (setq p1 (list px1 py1)
                  p2 (list px2 py2)
                  p3 (list px3 py3)        
                  p4 (list px4 py4)        
                )
        (setq ss_p (ssget "f" (list p1 p2 p3 p4 p1 )))
        (if (= (sslength ss_p) 1 )
                (progn
                (setq px1 (- px (/ jd1 2))
                px2 (- px (/ jd1 2) )
                px3 (+ px (/ jd1 2) )
                px4 (+ px (/ jd1 2) ))
        (setq py1 (+ py (/ jd1 2))
                py2 (- py (/ jd1 2) )
                py3 (- py (/ jd1 2) )
                py4 (+ py (/ jd1 2) ))        
               
        (setq p1 (list px1 py1)
                  p2 (list px2 py2)
                  p3 (list px3 py3)        
                  p4 (list px4 py4)        
                )
        (setq ss_p (ssget "f" (list p1 p2 p3 p4 p1 )))
        (if (!= (sslength ss_p) 1 )
        (command "CIRCLE" pt  dia ))
                )
))


附：这里面的mdxf 和 ss->enamelst 是自定义函数

远方小山

xinrstar 发表于 2016-3-6 12:02
用这个函数
返回曲线上离指定点最近的点（在 WCS 上）
(vlax-curve-getClosestPointTo curve-obj givenPn ...

可否劳驾大神给写几行代码

kozmosovia

远方小山 发表于 2016-3-6 13:21
这个方法我试过，但是效果不好，里面好多点在其他多段线上，也被检测出来，附代码如下，请大神指教。
(d ...

你的程序太啰嗦
随手写了一个，没测试。

2. 
   
3. ;;; Dis=端点到曲线距离
   
4. ;;; Rad=圆弧半径
   
5. (Defun _Process        (Dis Rad / EPT I OS SPT SS VLO XX)
   
6.   (setq os (getvar "osmode"))
   
7.   (setvar "osmode" 0)
   
8.   (if (setq i  -1
   
9.             ss (ssget '((0 . "*polyline") (70 . 0)))
   
10.       )
    
11.     (repeat (sslength ss)
    
12.       (setq vlo (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
    
13.       (foreach abc (list (trans (vlax-curve-getstartpoint vlo) 0 1)
    
14.                          (trans (vlax-curve-getendpoint vlo) 0 1)
    
15.                    )
    
16.         (if (and (setq xx (ssget "_cp"
    
17.                                  (polar abc (* 0.25 pi) (* 1.414 Dis))
    
18.                                  (polar abc (* 1.25 pi) (* 1.414 Dis))
    
19.                                  '((0 . "*polyline"))
    
20.                           )
    
21.                  )
    
22.                  (> (sslength xx) 1)
    
23.             )
    
24.           (command "_.Circle" abc Rad)
    
25.         )
    
26.       )
    
27.     )
    
28.   )
    
29.   (setvar "osmode" os)
    
30. )
    

<br /> ;;; Dis=端点到曲线距离<br /> ;;; Rad=圆弧半径<br /> (Defun _Process        (Dis Rad / EPT I OS SPT SS VLO XX)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (if (setq i  -1<br />             ss (ssget '((0 . "*polyline") (70 . 0)))<br />       )<br />     (repeat (sslength ss)<br />       (setq vlo (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))<br />       (foreach abc (list (trans (vlax-curve-getstartpoint vlo) 0 1)<br />                          (trans (vlax-curve-getendpoint vlo) 0 1)<br />                    )<br />         (if (and (setq xx (ssget "_cp"<br />                                  (polar abc (* 0.25 pi) (* 1.414 Dis))<br />                                  (polar abc (* 1.25 pi) (* 1.414 Dis))<br />                                  '((0 . "*polyline"))<br />                           )<br />                  )<br />                  (> (sslength xx) 1)<br />             )<br />           (command "_.Circle" abc Rad)<br />         )<br />       )<br />     )<br />   )<br />   (setvar "osmode" os)<br /> )<br />

xinrstar

远方小山 发表于 2016-3-6 13:22
可否劳驾大神给写几行代码

用7#的吧，代码更少，只要图在屏幕上就行

Gu_xl

(XLRX-Curve-CheckXuangua (ssget '((0 . "*line"))) 1.0 0.5)

远方小山

kozmosovia 发表于 2016-3-6 15:06
你的程序太啰嗦
随手写了一个，没测试。

我试了下，这个代码有出现错误，我查了用法，没有错啊，求大神指点
(if (and (setq xx (ssget "_cp"
                                 (polar abc (* 0.25 pi) (* 1.414 Dis))
                                 (polar abc (* 1.25 pi) (* 1.414 Dis))
                                 '((0 . "*polyline"))
）