求助 73哥 gzxl 004 skg123 各位大师来改改程序
;;检查高程匹配(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
总是提示错误 请老师们给看看 修改一下是不是缺少错误函数的原因啊
本帖最后由 llsheng_73 于 2015-8-12 21:50 编辑
(setq ssa (ssget "w" PA PB (LIST (cons 0 "TEXT")(cons 8 cen)) )))
这一行多了一个反)导致程序(defun rk()....)提前结束
后边多处 (< j (sslength ssa)) 之类的，弄得反括号一起失效。。。。不明白那些地方的用途，所以不知道怎么改
初步估计有可能是用了类似变量名任意替换之类的程序对最初的源代码进行处理后引起的。。。 这样不提示错误，但查错效果不行呀，程序思路不对吧
;;检查高程匹配
(defun c:jcgc (/ a a1 cen dir1 en ents file1 filen i p1 ph px py rks sss wj1 xh zbzf)
(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 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 px py ph rks)
(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 (px py ph rks / a3 a4 ang0 ax ay cen1 dist dist1 en1 en2 ents1 ents2 gcc h1 h2 h8 hh hha i1 j jj km obj p1 p2 p3 pa pa1 pb pb1 pp2 pz ssa ssb str2 x x1 y y1 yy1 zbzf)
(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 gcc 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 (nth 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 gcc (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 hh (atof hha))
(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
gzxl老师好，这个程序可能思路有问题，是在网上看到就收集起来了，怎么做都有问题，后来，zzxxqq老师给改过，运行了，但是不是想要的结果 这个应该有三个判断点，展点号图层里的小白点的属性高程值，gcd图层里块高程里有两个点，一个是高程值的文字，一个是高程块的属性值！三点都一样才是正确，
页:
[1]