进行高程点和等高线点线矛盾检查 ，求高手指点

YAOXIANWEI

(defun c:dxjc()
(setq EnAng 25)
(setq StpAng 30)
        (setq StpDis 2.0)
(setq SearchR 5.0)
        (setq blc 1)
        (setq bz1 0 bz2 0)
        (setq mm1 0 mm2 0)
(setq StpDis (* StpDis Blc))
        (setq gc (strcat "\n输入高程点所在图层:"))
(setq jqxc (strcat "\n输入计曲线所在图层:"))
(setq sqxc (strcat "\n输入首曲线所在图层:"))
(setq gcd (getstring gc))
(setq jqx (getstring jqxc))
        (setq sqx (getstring sqxc))
(setq LaJqx (strcase jqx))
(setq LaSqx (strcase sqx))
        (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 8 gcd))))
        (setq m 0)
        (setq l 0)
        (if (/= ss nil)
                     (progn
               (while (setq tname (ssname ss m))
                (setq ed (entget tname))
                (setq zb (cdr (assoc 10 ed)))
                (setq z (last (assoc 10 ed)))
                (setq Pnt0 zb)
              ;   (command"zoom" "c" zb "30")
(setq Done1 1)
        (setq EnDis StpDis)
(while (= Done1 1)
      (setq hbpi (* pi (/ enang 180.00000)))
      (setq Pnt1 (polar Pnt0 hbpi EnDis))
      (SETQ SS1 (SSGET "F" (LIST Pnt0 Pnt1)))
           ;  (setq len1 (sslength ss1))
             (setq pnt2 (polar Pnt0 hbpi (- 0 EnDis)))
             (SETQ SS2 (SSGET "F" (LIST pnt0 Pnt2)))
            ; (setq len2 (sslength ss2))
             (if (and (/= SS1 nil) (/= ss2 nil));2
             (progn   
           (SETQ LEN (SSLENGTH SS1))
           (setq n 0  En1VEL -1000)
                  (while (< n LEN) ;1
                      (setq bz1 0)
               (setq en1 (ssname SS1 n))
                      (if (> len 1)
                       (progn
               (setq enbz1 (ssname SS1 1))
               (setq SS1ed1 (entget enbz1))
                      (setq xx1 (cdr (assoc 6 ss1ed1)))
                       ))
               (setq SS1ed (entget en1))
               (SETQ Lay (CDR (ASSOC 8 SS1ED)))
                      (setq ename (cdr (assoc 0 ss1ed)))
                      (if (and (or (= (strcase ename) (strcase "polyline"))
                                   (= (strcase ename) (strcase "lwpolyline")))
                            (or (= Lay LaJqx) (= Lay LaSqx)))
                   (progn
                             (setq bz1 1)
                      ;(command "pline" pnt0 "w" 0.0 0.0  pnt1 "")
                             (setq entlist (entget en1))
                             (if (= (strcase ename) (strcase "polyline"))
                                 (setq En1VEL (nth 3 (assoc 10 entlist)))
                                 (setq En1VEL (cdr (assoc 38 entlist)))
                       )
                             (setq n LEN)
               ))   
               (setq n (+ n 1))
           ) ;1 (while (< n LEN)
                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                 (SETQ LEN (SSLENGTH SS2))
                (setq n 0 En2VEL 1000)
          (while (< n LEN)
                     (setq bz2 0)
              (setq en2 (ssname SS2 n))
                      (if (> len 1)
                      (progn
               (setq enbz2 (ssname SS2 1))
               (setq SS1ed2 (entget enbz2))
                      (setq xx2 (cdr (assoc 6 ss1ed2)))
                      ))
              (setq SS2ed (entget en2))
              (SETQ Lay (CDR (ASSOC 8 SS2ED)))
                     (setq ename (cdr (assoc 0 ss2ed)))
                (if (and (or (= (strcase ename) (strcase "polyline"))
                                  (= (strcase ename) (strcase "lwpolyline")))
                              (or (= Lay LaJqx) (= Lay LaSqx)))
                         (progn
                          (setq bz2 1)
                      ;(command "pline" pnt0 "w" 0.0 0.0  pnt2 "")
                             (setq entlist (entget en2))
                             (if (= (strcase ename) (strcase "polyline"))
                                 (setq En2VEL (nth 3 (assoc 10 entlist)))
                                 (setq En2VEL (cdr (assoc 38 entlist)))
                       )
                      (setq n LEN)
                    ))
              (setq n (+ n 1))
                  );1 (while (< n LEN)
                                (if (< en2vel en1vel)
                                    (progn
                                    (setq gczm en1vel)
                                    (setq gczx en2vel)
                                     )
                                    (progn
                                    (setq gczm en2vel)
                                    (setq gczx en1vel)
                                     )
                                  )
                 (if (or (and (> z gczx) (< z gczm))  (and (= xx1 "921") (= xx2 "921")) (and (= xx1 "922") (= xx2 "922")) (and (= xx1 "921") (= xx2 "922")) (and (/= xx1 "922") (= xx2 "921")))
                   (setq Done1 2)
                 (progn
                 (if (and (or (> z gczm) (< z gczx))  (/= gczx gczm) (/= En2VEL 1000) (/= en1vel -1000) (= bz1 1) (= bz2 1))
                 (progn
             ;    (command"change" tname "" "p" "la" "0" "")
                 (command"layer" "s" "0" "c" "1" "" "")
                 (command"_circle" zb "3")
                 (setq bz1 0 bz2 0)
                 (setq l (1+ l))
                 (setq Done1 2)
                  )
                (progn
             (setq EnAng (+ EnAng StpAng))
             (if (> EnAng 180)
                 (progn
                    (setq endis (+ endis stpdis))
                    (setq enang 25)
                    (if (> endis SearchR)
                       (setq Done1 2))
             ))))))
                 )))
                 (setq m (1+ m))
                 )
    (princ " \n共有[ ")
    (princ l)
    (princ " ] 处点线矛盾")
    (princ)
  ))
)

树櫴希德

怎么会没有人顶？

xujinhua

同行啊..不会帮顶

llsheng_73

点线矛盾对于搞测绘，特别是地形测绘那是很头痛的，这么强大一个功能，建议不要用COMMAND
很多年前弄过一个，虽然不会漏判但会误判，后来地形图弄得少了也就没管它了
应该先检查等高线之间高差是否与基本等高距相符，再考虑点线矛盾
一般用高程点根据比例尺在一定范围内选取等高线，找出离它最近的一根等高线，再找出与它反方向的另一根线或者与这要等高线高差等于基本等高距的等高线来判断，如果有错，从高程点到对应的等高线绘一条直线出来
建议要考虑地物、地貌，比如高程点到最近的等高线间有一个陡坎，这时是不应该计算高程点与等高线高程的差是否小于基本等高距的，另外，你应该说说你的主要思路，而不是直接发一大串代码，毕竟看程序很累，而思路是否清晰，是否可行，这相对比较容易判断

yhly555

我用了一直卡死，你用的正常吗？谢谢！

技术工作室

支持一下顶一个

zzhangjunj

yhly555 发表于 2019-10-15 15:15
我用了一直卡死，你用的正常吗？谢谢！

我用了也一直卡死