求助高手老师给看看程序的错误在那里

杜阳 · 发表于 2015-7-30 21:52:00

;;检查高程匹配
(defun c:jcgc()
(command "osnap" "off")
(command "layer" "th" "*" "unlock" "*" "")
(command "layer" "m" "gcd" "on" "*" "" )
(command "layer" "S" "0" "")
(setq file1 (getvar "DWGNAME"))
(setq dir1 (getvar "DWGPREFIX"))
(setq XH (strcase (substr file1 1 (- (strlen file1) 4))))
(SETQ FILEN (STRCAT DIR1 XH ".检查高程"))
(setq wj1 (open FILEN "a"))
(setq rks 0)
(write-line " -------------------------------------------------------------" wj1)
(setq zbzf (strcat "检查图幅名：" XH "检查时间" ))
(write-line "" wj1)
(setq zbzf (strca " ----- " "高程匹配检查" "----- " ))
(write-line zbzf wj1)
(write-line "" wj1)
(close wj1)
(setq wj1 (open FILEN "a"))
(setq sss (ssget "x" (LIST (cons 8 "gcd")(cons 0 "INSERT")(cons 2 "gC200"))))
(setq i 0)
(if sss
(while (< i (sslength sss))
;;z
(setq ents (ssname sss i))
(setq en (entget ents))
(setq P1 (cdr (assoc 10 en)) )
(setq cen (cdr (assoc 8 en)) )
(setq px (nth 0 p1))
(setq py (nth 1 p1))
(setq ph (nth 2 p1))
(rk)
(setq i (+ i 1))))
(setq a (itoa rks) )
(If(= cen cen1)
(setq a1 (strcat ",本幅图找到不匹配高程个数:" a "个" ) ))
(If(/= cen cen1)
(setq a1 "高程层次错误。按ESC键盘退出..." ))
(write-line "" wj1)
(print a1)
(close wj1)
(print "检查完事")
(princ))

(defun rk()
(setq pz 0)
(setq p1 (list px py))
(command "zoom" "c" p1 (* 40 1.000))
(setq x (* 11 1.000))
(setq y (* 5 1.000))
(setq pa (list (- px x) (- py y)))
(setq pB (list (+ px x) (+ py y)))
(setq ssa nil)
(setq hha "0")
(setq ssa (ssget "w" PA PB (LIST (cons 0 "TEXT")(cons 8 cen)) )))
(setq j 0)
(SETQ GC 0)
(setq dist 6000)
(SETQ h2 nil)
(SETQ h1 nil)
(if(= ssa nil )
(progn
(command "zoom" "c" p1 (* 40 0.5))
(command "circle" p1 (* 2 0.5))
(setq yy1 (strcat "\n未找到高程注记,请检查高程层次是否为gcd，确认后再选择高程<" hha ">: "))
(setq oBJ (car (entsel yy1)))
(IF(/= OBJ NIL)
(PROGN
(setq en1 (entget oBJ))
;setq
(setq hhA (cdr (assoc 1 en1)) )
(setq hh (atof hhA))
(setq cen1 (cdr (assoc 8 en1)) )
(If(/= cen cen1)
(progn
(command "zoom" "c" p1 (*40 0.5))
(GETSTRING (strcat "高程层次错误。按ESC键盘退出....")) ))
(setq j 1)
(setq DIST 1)
)) ))
(if ssa
(while (< j (sslength ssa))
(setq ents1 (ssname ssa j))
(setq en1 (entget ents1))
(setq km (cdr (assoc 1 en1)) )
(setq P2 (cdr (assoc 10 en1)) )
(setq ax (th 0 p2))
(setq ay (nth 1 p2))
(setq cen1 (cdr (assoc 8 en1)) )
(setq ang0 (/ (* (angle p1 p2) 180) 3.14159))
(setq pp2 p2)
(cond
((and (> ang0 100) (<= ang0 190))
(setq pp2 (list (+ ax 24) ay))
)
((and (> ang0 190) (<= ang0 250))
(setq pp2 (list (+ ax 24) (+ ay 10)))
)
((and (> ang0 250) (<= ang0 350))
(setq pp2 (list ax (+ ay 10))))
)
(SETQ DIST1 (DISTANCE P1 Pp2))
(IF (> DIST DIST1)
(PROGN
(SETQ DIST DIST1)
(SETQ GC (ATOF KM))
(SETQ EN2 EN1)
(setq hha km)
(setq hh (atof km))
(setq ents2 ents1) ))
(setq j (+ j 1)) ))
(setq x1 (* 2 0.5))
(setq y1 (* 2 0.5))
(setq pa1 (list (- px x1) (- py y1)))
(setq pB1 (list (+ px x1) (+ py y1)))
(setq ssb nil)
(setq ssb (ssget "w" PA1 PB1 (LIST (cons 8 "gcd") (cons 0 "INSERT") (cons 2 "gc200"))))
;(command "pline" pa1 pb1 """")
(setq jj 0)
(if ssb
(while (< jj (sslength ssb))
(setq ents2 (ssname ssb jj))
(setq en2 (entget ents2))
(setq km (cdr (assoc 1 en2)) )
;(setq P5 (cdr (assoc 10 en2)) )
;(command "circle" p5 (* 5 0.5))
(setq jj (+ jj 1)) ))
(if (or (= j 1) (< dist 10))
(progn
(setq p3 (list (nth 0 p1) (nth 1 p1) hh))
(setq x1 (rtos px 2 3))
(setq y1 (rtos py 2 3))
(setq h1 (rtos hh 2 3))
(setq h2 (rtos ph 2 3))
(setq i1 (rtos (+ rks 1) 2 0))
(setq a3 (strcat " 标注高程 " h1))
(setq a4 (strcat " 点位高程 " h2))
(setq h8 (abs(- hh ph )))
(if (> h8 0.01)
(progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "circle" p1 (* 2 0.5))
(setq str2 (getstring (strcat a3 a4 " 是否记录(回车记录,No不记录se选择esc中断修改)")))
(command "u")
(if (= str2 "se")
(progn
(setq yy1 (strcat "\n找到多个实体,请选择高程<" hha ">: "))
(setq oBJ (car (entsel yy1)))
(IF(/= OBJ NIL)
(PROGN
(setq en1 (entget oBJ))
;setq
(setq hhA (cdr (assoc 1 en1)) )
(setq hh (atof hhA))
(setq j 1)
(setq DIST 1) ))
(if (or (= j 1) (< dist 10))
;a
(progn
(setq p3 (list (nth 0 p1) (nth 1 p1) hh))
(setq x1 (rtos px 2 3))
(setq y1 (rtos py 2 3))
(setq h1 (rtos hh 2 3))
(setq h2 (rtos ph 2 3))
(setq i1 (rtos (+ rks 1) 2 0))
(setq a3 (strcat " 标注高程 " h1))
(setq a4 (strcat " 点位高程 " h2))
(setq h8 (abs(- hh ph)))
(if (> h8 0.01)
(progn
;;;;;;;;;;;;;;;;
(command "circle" p1 (* 2 0.5))
(setq str2 (getstring (strcat a3 a4 " 是否记录(回车记录,No不记录？)")))
(command "u"))) )) ))
(if (= str2 "")
(progn
;;;;;;;;;;;;;;;;
(command "change" ssb "" "p" "e" h1 "la" "BJ08" "c" "bylayer" "")
(print "已记录")
(setq zbzf (strcat " 图元 "i1": (" x1 " " y1 " "a3 a4 " 高程值不符" ))
(write-line zbzf wj1)
(setq rks (+ rks 1)) )) )) ) ) );;;end

ZZXXQQ · 发表于 2015-7-31 09:43:45

;错误百出

;;检查高程匹配
(defun c:jcgc()
(command "osnap" "off")
(command "layer" "th" "*" "unlock" "*" "")
(command "layer" "m" "gcd" "on" "*" "")
(command "layer" "S" "0" "")
(setq file1 (getvar "DWGNAME"))
(setq dir1 (getvar "DWGPREFIX"))
(setq XH (strcase (substr file1 1 (- (strlen file1) 4))))
(setq FILEN (strcat DIR1 XH ".检查高程"))
(setq wj1 (open FILEN "a"))
(setq rks 0)
(write-line " -------------------------------------------------------------" wj1)
(setq zbzf (strcat "检查图幅名：" XH "检查时间"))
(write-line "" wj1)
(setq zbzf (strcat " ----- " "高程匹配检查" "----- "))
(write-line zbzf wj1)
(write-line "" wj1)
(close wj1)
(setq wj1 (open FILEN "a"))
(setq i 0)
(if (setq sss (ssget "x" '((0 . "INSERT")(2 . "gC200")(8 . "gcd"))))
(while (< i (sslength sss))
(setq en (entget (ssname sss i)))
(setq P1 (cdr (assoc 10 en)) )
(setq cen (cdr (assoc 8 en)) )
(setq px (car p1))
(setq py (cadr p1))
(setq ph (last p1))
(rk)
(setq i (1+ i))
)
)
(setq a (itoa rks) )
(if (equal cen cen1 1e-6)
(setq a1 (strcat ",本幅图找到不匹配高程个数:" a "个"))
(setq a1 "高程层次错误。按ESC键盘退出...")
)
(write-line "" wj1)
(print a1)
(close wj1)
(print "检查完事")
(princ)
)
(defun rk()
(setq pz 0)
(setq p1 (list px py))
(command "zoom" "c" p1 40)
(setq x 11.0)
(setq y 5.0)
(setq pa (list (- px x) (- py y)))
(setq pB (list (+ px x) (+ py y)))
(setq ssa nil)
(setq hha "0")
(setq ssa (ssget "w" PA PB (list '(0 . "TEXT")(cons 8 cen))))
(setq j 0)
(setq GC 0)
(setq dist 6000)
(setq h2 nil)
(setq h1 nil)
(if(= ssa nil ) (progn
(command "zoom" "c" p1 20)
(command "circle" p1 1)
(setq yy1 (strcat "\n未找到高程注记,请检查高程层次是否为gcd，确认后再选择高程<" hha ">: "))
(setq oBJ (car (entsel yy1)))
(if(/= OBJ nil) (progn
(setq en1 (entget oBJ))
;setq
(setq hhA (cdr (assoc 1 en1)) )
(setq hh (atof hhA))
(setq cen1 (cdr (assoc 8 en1)) )
(if(/= cen cen1) (progn
(command "zoom" "c" p1 20)
(getstring (strcat "高程层次错误。按ESC键盘退出...."))
))
(setq j 1)
(setq DIST 1)
))
)
(while (< j (sslength ssa))
(setq ents1 (ssname ssa j))
(setq en1 (entget ents1))
(setq km (cdr (assoc 1 en1)) )
(setq P2 (cdr (assoc 10 en1)) )
(setq ax (car p2))
(setq ay (cadr p2))
(setq cen1 (cdr (assoc 8 en1)) )
(setq ang0 (/ (* (angle p1 p2) 180) pi))
(setq pp2 p2)
(cond
((and (> ang0 100) (<= ang0 190)) (setq pp2 (list (+ ax 24) ay)))
((and (> ang0 190) (<= ang0 250)) (setq pp2 (list (+ ax 24) (+ ay 10))))
((and (> ang0 250) (<= ang0 350)) (setq pp2 (list ax (+ ay 10))))
)
(setq DIST1 (distance P1 Pp2))
(if (> DIST DIST1) (progn
(setq DIST DIST1)
(setq GC (atof KM))
(setq EN2 EN1)
(setq hha km)
(setq hh (atof km))
(setq ents2 ents1)
))
(setq j (1+ j))
)
)
(setq x1 1.0)
(setq y1 1.0)
(setq pa1 (list (- px x1) (- py y1)))
(setq pB1 (list (+ px x1) (+ py y1)))
(setq ssb nil)
;(command "pline" pa1 pb1 """")
(setq jj 0)
(if (setq ssb (ssget "w" PA1 PB1 '((0 . "INSERT")(2 . "gc200")(8 . "gcd"))))
(while (< jj (sslength ssb))
(setq ents2 (ssname ssb jj))
(setq en2 (entget ents2))
(setq km (cdr (assoc 1 en2)) )
;(setq P5 (cdr (assoc 10 en2)) )
;(command "circle" p5 (* 5 0.5))
(setq jj (1+ jj))
)
)
(if (or (= j 1) (< dist 10)) (progn
(setq p3 (list (car p1) (cadr p1) hh))
(setq x1 (rtos px 2 3))
(setq y1 (rtos py 2 3))
(setq h1 (rtos hh 2 3))
(setq h2 (rtos ph 2 3))
(setq i1 (rtos (+ rks 1) 2 0))
(setq a3 (strcat " 标注高程 " h1))
(setq a4 (strcat " 点位高程 " h2))
(setq h8 (abs(- hh ph )))
(if (> h8 0.01) (progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "circle" p1 (* 2 0.5))
(setq str2 (getstring (strcat a3 a4 " 是否记录(回车记录,No不记录se选择esc中断修改)")))
(command "u")
(if (= str2 "se") (progn
(setq yy1 (strcat "\n找到多个实体,请选择高程<" hha ">: "))
(setq oBJ (car (entsel yy1)))
(if(/= OBJ nil) (progn
(setq en1 (entget oBJ))
;setq
(setq hhA (cdr (assoc 1 en1)) )
(setq hh (atof hhA))
(setq j 1)
(setq DIST 1)
))
(if (or (= j 1) (< dist 10)) (progn
(setq p3 (list (nth 0 p1) (nth 1 p1) hh))
(setq x1 (rtos px 2 3))
(setq y1 (rtos py 2 3))
(setq h1 (rtos hh 2 3))
(setq h2 (rtos ph 2 3))
(setq i1 (rtos (+ rks 1) 2 0))
(setq a3 (strcat " 标注高程 " h1))
(setq a4 (strcat " 点位高程 " h2))
(setq h8 (abs(- hh ph)))
(if (> h8 0.01) (progn
;;;;;;;;;;;;;;;;
(command "circle" p1 (* 2 0.5))
(setq str2 (getstring (strcat a3 a4 " 是否记录(回车记录,No不记录？)")))
(command "u")
))
))
))
(if (= str2 "") (progn
;;;;;;;;;;;;;;;;
(command "change" ssb "" "p" "e" h1 "la" "BJ08" "c" "bylayer" "")
(print "已记录")
(setq zbzf (strcat " 图元 " i1 ": (" x1 " " y1 " "a3 a4 " 高程值不符"))
(write-line zbzf wj1)
(setq rks (1+ rks))
))
))
))
)

;;检查高程匹配 
(defun c:jcgc() 
 (command "osnap" "off") 
 (command "layer" "th" "*" "unlock" "*" "") 
 (command "layer" "m" "gcd" "on" "*" "") 
 (command "layer" "S" "0" "") 
 (setq file1 (getvar "DWGNAME")) 
 (setq dir1 (getvar "DWGPREFIX")) 
 (setq XH (strcase (substr file1 1 (- (strlen file1) 4)))) 
 (setq FILEN (strcat DIR1 XH ".检查高程")) 
 (setq wj1 (open FILEN "a")) 
 (setq rks 0) 
 (write-line " -------------------------------------------------------------" wj1) 
 (setq zbzf (strcat "检查图幅名：" XH "检查时间")) 
 (write-line "" wj1) 
 (setq zbzf (strcat " ----- " "高程匹配检查" "----- ")) 
 (write-line zbzf wj1) 
 (write-line "" wj1) 
 (close wj1) 
 (setq wj1 (open FILEN "a")) 
 (setq i 0) 
 (if (setq sss (ssget "x" '((0 . "INSERT")(2 . "gC200")(8 . "gcd")))) 
  (while (
   (setq en (entget (ssname sss i))) 
   (setq P1 (cdr (assoc 10 en)) ) 
   (setq cen (cdr (assoc 8 en)) ) 
   (setq px (car p1)) 
   (setq py (cadr p1)) 
   (setq ph (last p1)) 
   (rk) 
   (setq i (1+ i)) 
  ) 
 ) 
 (setq a (itoa rks) ) 
 (if (equal cen cen1 1e-6) 
  (setq a1 (strcat ",本幅图找到不匹配高程个数:" a "个")) 
  (setq a1 "高程层次错误。按ESC键盘退出...") 
 ) 
 (write-line "" wj1) 
 (print a1) 
 (close wj1) 
 (print "检查完事") 
 (princ) 
) 
(defun rk() 
 (setq pz 0) 
 (setq p1 (list px py)) 
 (command "zoom" "c" p1 40) 
 (setq x 11.0) 
 (setq y 5.0) 
 (setq pa (list (- px x) (- py y))) 
 (setq pB (list (+ px x) (+ py y))) 
 (setq ssa nil) 
 (setq hha "0") 
 (setq ssa (ssget "w" PA PB (list '(0 . "TEXT")(cons 8 cen)))) 
 (setq j 0) 
 (setq GC 0) 
 (setq dist 6000) 
 (setq h2 nil) 
 (setq h1 nil) 
 (if(= ssa nil ) (progn 
  (command "zoom" "c" p1 20) 
  (command "circle" p1 1) 
  (setq yy1 (strcat "\n未找到高程注记,请检查高程层次是否为gcd，确认后再选择高程<" hha ">: ")) 
  (setq oBJ (car (entsel yy1))) 
  (if(/= OBJ nil) (progn 
   (setq en1 (entget oBJ)) 
;setq 
   (setq hhA (cdr (assoc 1 en1)) ) 
   (setq hh (atof hhA)) 
   (setq cen1 (cdr (assoc 8 en1)) ) 
   (if(/= cen cen1) (progn 
    (command "zoom" "c" p1 20) 
    (getstring (strcat "高程层次错误。按ESC键盘退出....")) 
   )) 
   (setq j 1) 
   (setq DIST 1) 
  )) 
 ) 
  (while (< j (sslength ssa)) 
   (setq ents1 (ssname ssa j)) 
   (setq en1 (entget ents1)) 
   (setq km (cdr (assoc 1 en1)) ) 
   (setq P2 (cdr (assoc 10 en1)) ) 
   (setq ax (car p2)) 
   (setq ay (cadr p2)) 
   (setq cen1 (cdr (assoc 8 en1)) ) 
   (setq ang0 (/ (* (angle p1 p2) 180) pi)) 
   (setq pp2 p2) 
   (cond 
    ((and (> ang0 100) (<= ang0 190)) (setq pp2 (list (+ ax 24) ay))) 
    ((and (> ang0 190) (<= ang0 250)) (setq pp2 (list (+ ax 24) (+ ay 10)))) 
    ((and (> ang0 250) (<= ang0 350)) (setq pp2 (list ax (+ ay 10)))) 
   ) 
   (setq DIST1 (distance P1 Pp2)) 
   (if (> DIST DIST1) (progn 
    (setq DIST DIST1) 
    (setq GC (atof KM)) 
    (setq EN2 EN1) 
    (setq hha km) 
    (setq hh (atof km)) 
    (setq ents2 ents1) 
   )) 
   (setq j (1+ j)) 
  ) 
 ) 
 (setq x1 1.0) 
 (setq y1 1.0) 
 (setq pa1 (list (- px x1) (- py y1))) 
 (setq pB1 (list (+ px x1) (+ py y1))) 
 (setq ssb nil) 
;(command "pline" pa1 pb1 """") 
 (setq jj 0) 
 (if (setq ssb (ssget "w" PA1 PB1 '((0 . "INSERT")(2 . "gc200")(8 . "gcd")))) 
  (while (< jj (sslength ssb)) 
   (setq ents2 (ssname ssb jj)) 
   (setq en2 (entget ents2)) 
   (setq km (cdr (assoc 1 en2)) ) 
;(setq P5 (cdr (assoc 10 en2)) ) 
;(command "circle" p5 (* 5 0.5)) 
   (setq jj (1+ jj)) 
  ) 
 ) 
 (if (or (= j 1) (< dist 10)) (progn 
  (setq p3 (list (car p1) (cadr p1) hh)) 
  (setq x1 (rtos px 2 3)) 
  (setq y1 (rtos py 2 3)) 
  (setq h1 (rtos hh 2 3)) 
  (setq h2 (rtos ph 2 3)) 
  (setq i1 (rtos (+ rks 1) 2 0)) 
  (setq a3 (strcat " 标注高程 " h1)) 
  (setq a4 (strcat " 点位高程 " h2)) 
  (setq h8 (abs(- hh ph ))) 
  (if (> h8 0.01) (progn 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
   (command "circle" p1 (* 2 0.5)) 
   (setq str2 (getstring (strcat a3 a4 " 是否记录(回车记录,No不记录se选择esc中断修改)"))) 
   (command "u") 
   (if (= str2 "se") (progn 
    (setq yy1 (strcat "\n找到多个实体,请选择高程<" hha ">: ")) 
    (setq oBJ (car (entsel yy1))) 
    (if(/= OBJ nil) (progn 
     (setq en1 (entget oBJ)) 
;setq 
     (setq hhA (cdr (assoc 1 en1)) ) 
     (setq hh (atof hhA)) 
     (setq j 1) 
     (setq DIST 1) 
    )) 
    (if (or (= j 1) (< dist 10)) (progn 
     (setq p3 (list (nth 0 p1) (nth 1 p1) hh)) 
     (setq x1 (rtos px 2 3)) 
     (setq y1 (rtos py 2 3)) 
     (setq h1 (rtos hh 2 3)) 
     (setq h2 (rtos ph 2 3)) 
     (setq i1 (rtos (+ rks 1) 2 0)) 
     (setq a3 (strcat " 标注高程 " h1)) 
     (setq a4 (strcat " 点位高程 " h2)) 
     (setq h8 (abs(- hh ph))) 
     (if (> h8 0.01) (progn 
;;;;;;;;;;;;;;;; 
      (command "circle" p1 (* 2 0.5)) 
      (setq str2 (getstring (strcat a3 a4 " 是否记录(回车记录,No不记录？)"))) 
      (command "u") 
     )) 
    )) 
   )) 
   (if (= str2 "") (progn 
;;;;;;;;;;;;;;;; 
    (command "change" ssb "" "p" "e" h1 "la" "BJ08" "c" "bylayer" "") 
    (print "已记录") 
    (setq zbzf (strcat " 图元 " i1 ": (" x1 " " y1 " "a3 a4 " 高程值不符")) 
    (write-line zbzf wj1) 
    (setq rks (1+ rks)) 
   )) 
  )) 
 )) 
)

杜阳 · 发表于 2015-7-31 15:10:37

ZZXXQQ 发表于 2015-7-31 09:43
;错误百出

谢谢老师的及时回复与修改，程序运行了，运行后所有的高程点都给画圆圈了对的也给画了

杜阳 · 发表于 2015-7-31 15:12:52

ZZXXQQ 发表于 2015-7-31 09:43
;错误百出

(setq yy1 (strcat "\n未找到高程注记,请检查高程层次是否为gcd，确认后再选择高程<" hha ">: "))
只执行了这个如果展点的高程和高程点块的高程不符合时才给画圈就对了这个都给画圈了我在去看看谢谢老师在百忙之中给予解答和回复修改祝福老师

账号		自动登录	找回密码
密码			注册

[提问] 求助高手老师给看看程序的错误在那里

相关帖子