【请教】用LSP绘等高线问题

wmz

以下是一同高程的等高线数据，但不是顺序连接的，须要将其理顺。它是有规律可循的：其中每一行都有一个点编号，
成组排列，即紧挨着的两个相同的编号但坐标不同的点为一组，一直到N行(n为偶数)，其规律就是每一组点被称为入
口点和出口点。利用重合点原则，可知这一组的出口点有可能是下一组的入口点(或者出口点)的重合点,如此循环往复，
直至找不到重合点为止。
    我是用双重循环写了一段代码来达到上述目的的,双重循环特费时间,加上循环里有多个逻辑运算,所以运行太慢，
请教大侠们。现将代码附上，请大侠们优化指导为感！

;;;搜索等值点并理顺点与点的关系使之能连接成等高线
(defun scdgx(db k / kk k1 k2 bh p0 pp0 pz Dyx i j m p xh e)
           (setq kk k k1 0 k2 2 bh 0 BZ '() p1 '() e 0.0001)
           (setq bz (cons (car(nth 2 db)) bz) pp0 (cadr(nth 1 db)) Dyx (cadr(nth 2 db)) p0 Dyx m 0 i 1)
           (while (<= i kk)   ;;左搜索
                (setq i (1+ i) j 1 p nil)
             (if (= bh 0)(progn
              (while (<= j kk)
                     (setq pz (nth j db) xh (car pz) p (cadr pz))
                   (if (and(/= k2 j)(< (distance Dyx p) e))(progn
                       (if (= XH (car(nth(- j 1)db)))(progn
                         (setq Dyx p)
                         (setq  p1 (cons Dyx p1))
                         (setq  BZ (cons XH BZ))
                        ))
                       (if (= XH (car(nth (+ j 1)db)))(progn
                         (setq Dyx (cadr(nth(+ j 1)db)))
                         (setq  p1 (cons Dyx p1))
                         (setq  BZ (cons XH BZ))
                        ))
                       (setq k2 (+ j 1))
                       (if (/= (rem k2 2) 0)(progn
                           (setq dyx (cadr(nth(- j 1) db)))
                           (setq  p1 (cons Dyx p1))
                           (setq  BZ (cons XH BZ))
                           (setq  k2 (- j 1))
                       ))
                       (setq k1 (+ k1 1))
                       (if (and(> k1 2)(or(< (distance p p0) e)(< (distance p pp0) e)))(progn
                            (setq BH 1 k1 (- k1 1))
                            (Hdgxx p1 bh dgx blc)
                            (setq j (+ kk 1) i (+ kk 1)) ;;;若闭合(BH=1)则终止本区域该一等高线的搜索
                       ))
                       (setq m j j (+ kk 1))
                   )
                   );end if
                 (setq j (1+ j))
              );;;end repeat kk_j
             ))
                 (setq j 1)
            );;;end repeat kk_i
                  (setq p1 (reverse p1))
        (if (= bh 0)(progn
             (setq Dyx (cadr(nth 1 db)) k2 1 m 0 i 1)
           (while (<= i kk)                    ;;右搜索
                (setq i (1+ i) j 1 p nil)
              (while (<= j kk)
                    (setq pz (nth j db) xh (car pz) p (cadr pz))
                   (if (and(/= k2 j)(< (distance Dyx p) e))(progn
                       (if (= XH (car(nth(- j 1)db)))(progn
                         (setq Dyx p)
                         (setq  p1 (cons Dyx p1))
                         (setq  BZ (cons XH BZ))
                        ))          
                       (if (= XH (car(nth(+ j 1) db)))(progn
                         (setq Dyx (cadr(nth(+ j 1) db)))
                         (setq  p1 (cons Dyx p1))
                         (setq  BZ (cons XH BZ))
                        ))
                       (setq k2 (+ j 1))
                       (if (and(> j 0)(/= (rem k2 2) 0))(progn
                         (setq dyx (cadr(nth(- j 1) db)))
                         (setq  p1 (cons Dyx p1))
                         (setq  BZ (cons XH BZ))     
                         (setq  k2 (- j 1))
                       ))
                       (setq k1 (+ k1 1))
                       (setq m j j (+ kk 1))
                   ));end if
                  (setq j (1+ j))
              );;;end repeat kk_j
                 (setq j 1)
            );;;end repeat kk_i
             (Hdgxx p1 bh dgx blc)
          ))
  )

1. 
   

复制代码

;;;加入扩展数据
(defun SetData (Obj Data / dxf)
   (setq  dxf (entget obj))
   (setq data (list(list "SOUTH" (cons 1000 data))))
   (foreach x Data
        (regapp (car x))
        (entmod (append dxf (list(cons -3 (list x)))))
   )
)
;;;生成等高线
(defun Hdgxx (lst bh h blc / BL n XX xk LAY YS e xDATA)
  (setq  sw 34.576 BL (/ blc 1000.0))
  (setq   n (length lst))
  (setq LAY (if(>= h sw)"DGX""DSX")
         XK (*(IF(=(rem h 5)0)0.3 0.15)BL)
   YS (IF(=(rem h 5)0) 3 2)
   XX (if(>= h sw)"CONTINUOUS""X11")
  )
  (setq xDATA (cond ((and (= (rem h 5) 0)(= LAY "DGX")) "201102")
        ((and(/= (rem h 5) 0)(= LAY "DGX")) "201101")
        ((and (= (rem h 5) 0)(= LAY "DSX")) "186302")
        ((and(/= (rem h 5) 0)(= LAY "DSX")) "186301")
        )
  )  
  (entmakex (append
       (list '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
        (cons 8 LAY)
        (cons 62 Ys)
        (cons 90 n)
        (cons 6 xx)
        (cons 43 xk)
        (cons 38 h)
        (cons 70 (+ 132 bh))
      )
      (mapcar '(lambda (pt)(cons 10 pt)) lst))
  )
  (setq e (entlast))
  (SetData e xDATA)
  (command "_pedit" e "s" "L" "on" "")
)

wmz

主要是左搜索右搜索占了运行时间的90%，这一部分的算法不科学，请高人指导！

This_is丶Stan

请你你这是等高线自动生成吗

wmz

This_is丶Stan 发表于 2015-4-14 13:28
请你你这是等高线自动生成吗

是的，读三角网文件生成等高线

This_is丶Stan

wmz 发表于 2015-4-15 09:19
是的，读三角网文件生成等高线

我要用LISP做等高线自动生成程序，请问能帮我吗