请教LISP高手（关于高程点的自动检查）

sydney2000

前几天在网上找的这样一段关于高程点注记的检查程序，好像不能用，请高手指教，现急用，不甚感激！

(defun c:gcdjc ()
  (setvar "cmdecho" 0)
  (write-line "欢迎使用高程点自动检查与修改程序!")
  (setq ent (ssget "x" ((8, "gcd") (0, "text"))))
  (if ent
    (progn
      (command "zoom" "e")
      (command "layer" "m" "gcd" "")
      (setq ent_length (sslength ent))
      (setq ent_number 0)
      (repeat ent_length
 (setq ent_name (ssname ent ent_number))
 (clgcd)
 (setq ent_number (1+ent_number))
      )
      (command "layer" "In" "0" "")
      (command "zoom" "e")
      (write-line "高程点检查修改完毕!")
    )
  )
)
(defun clgcd ()
  (setq data (entget ent_name))
  (setq rex (cdr (assoc 1 data)))
  (setq P (cdr (assoc 10 data)))
  (setq pl (polar P (* 1.25 pi) 7,0)
 pr (polar P (* 0.25 pi) 10,0)
  )
  (setq ent-P (ssget "w" pl pr ((0, "point") (8, "gcd"))))
  (if ent-P
    (progn
      (setq p_length (sslength ent-P))
      (setq p_number 0)
      (setq p_data (entget (ssname ent-P p_number)))
      (setq gcdz (rtos (cadddr (assoc 10 p_data)) 2 2))
      (setq wc (- (atof gcdz) (atof tex)))
      (while (and
        (>= (abs wc) 0.01)
        (<p_number (1-P_length))
      )
 (setq p_number (1+p_number))
 (setq p_data (entget (ssname ent-P p_number)))
 (setq gcdz (rtos (cadddr (assoc 10 p_data)) 2 2))
 (setq wc (- (atof gcdz) (atof rex)))
      )
      (if (>= (abs wc) 0.O1)
 (progn
   (command "zoom" pl pr)
   (write-line "无匹配高程点，请选择需要修改的高程点，不选择则自动加点．")
   (redraw ent_name 3)
   (setq p_sel (ssget))
   (redraw ent_name 4)
   (if p_sel
     (progn
       (setq sel (entget (ssname P_sel 0)))
       (setq X (cadr (assoc 10 sel))
      Y (caddr (assoc 10 sel))
       )
       (setq zb_new (1ist 10 X Y (atof tex)))
       (setq sel (subst
     zb_new
     (assoc 10 sel)
     sel
   )
       )
       (entmod sel)
     )
     (jiagcd)
   )
   (command "zoom" "e")
 )
      )
    )
  )
  (jiagcd)
)
(defun jiagcd ()
  (setq P-xy (polar (polar P (*0.5 pi) 0.5) pi 0.8))
  (command "point" P-xy)
  (command "change" "l" "" "P" "e" (atof tex) "")
)

danxingpen

不知道什么叫高程点,,,就程序本身的格式改下:
(setq ent (ssget "x" ((8, "gcd") (0, "text"))))
(setq ent (ssget "x" '((8, "gcd") (0, "text"))));加一个'号
 (setq ent_number (1+ent_number))
 (setq ent_number (1+ ent_number));空格
(setq ent-P (ssget "w" pl pr ((0, "point") (8, "gcd"))))
(setq ent-P (ssget "w" pl pr '((0, "point") (8, "gcd"))));加一个'号
(<p_number (1-P_length))
(< p_number (1- P_length));空格
(setq p_number (1+p_number))
(setq p_number (1+ p_number));空格
(setq P-xy (polar (polar P (*0.5 pi) 0.5) pi 0.8))
(setq P-xy (polar (polar P (* 0.5 pi) 0.5) pi 0.8));空格

jdhszh

这个不错式试http://bbs.mjtd.com/forum.php?mod=viewthread&tid=66699

sydney2000

问题已解决，非常感谢楼上两位。

晴天蓝海蓝羽

sydney2000 发表于 2008-4-26 18:09
问题已解决，非常感谢楼上两位。

请问楼主怎么解决的？能否发一下程序？