[LISP程序]：[LISP程序]：此程序有点问题谁能修改一下？

TJSKCC

根据高程注记加点位


(defun c:jgcd()
(setq ent (ssget "x" (list (cons 8 "gcd")(cons 0 "TEXT"))))
(if ent (progn
(command"zoom" "e")
(setvar "osmode" 0)
(write-line "正在给没有点位的高程注记加点位，请稍侯。。。。")
(command"layer" "m" "gcd" "")
(setq long-ent (sslength ent))
(setq num-ent 0)
(repeat long-ent
(setq ty (ssname ent num-ent))
(c:findd)
(setq num-ent (1+ num-ent))
)
(command"layer" "m" "0" "")
(command"zoom" "p")
(write-line"　　　　　　　 ok　 ")
(print)
))
)
                                   

(defun c:findd()
(setq data (entget ty))
(SETQ TEX (CDR (ASSOC 1 DATA)))
(setq p (cdr (assoc 10 data)))
(setq pl (polar p (* 1.25 pi) 11.0)
pr (polar p (* 0.18 pi) 17))
(setq ent-p (ssget "w" pl pr '((0 . "POINT")(1 . "gcd"))))
(if ent-p (progn ;注记周围有点
(SETQ Long-p (sslength ent-p))
(setq num-p 0)
(setq data-p (entget (ssname ent-p num-p)))
(setq gcdz (rtos (cadddr (assoc 10 data-p)) 2 2))
(while (and (/= gcdz tex)(< num-p (1- long-p)))
(setq num-p (1+ num-p))
(setq data-p (entget (ssname ent-p num-p)))
(setq gcdz (rtos (cadddr (assoc 10 data-p)) 2 2))
)
(if (/= gcdz tex) (c:jiad))
)
(c:jiad) ;注记周围无点
)
)

(defun c:jiad()
(setq p-point (polar (polar p (* 0.5 pi) 1) pi 1.0))
(command"point" p-point)
(command"change" (entlast) "" "p" "e" (atof tex) "t" "1610000" "")
)

xyp1964

2. [FONT=courier new]
   
3. (defun c:jgcd ()
   
4.   (command ".undo" "BE")
   
5.   (setvar "pdmode" 99)
   
6.   (setvar "pdsize" 20)
   
7.   (if (setq ent (ssget "x" (list (cons 8 "gcd") (cons 0 "TEXT"))))
   
8.     (progn
   
9.       (command "zoom" "e")
   
10.       (setvar "osmode" 0)
    
11.       (princ "\n正在给没有点位的高程注记加点位，请稍侯...")
    
12.       (command "layer" "m" "gcd" "")
    
13.       (setq long-ent (sslength ent)
    
14.             i             0
    
15.       )
    
16.       (repeat long-ent
    
17.         (setq ty   (ssname ent i)
    
18.               data (entget ty)
    
19.               p           (cdr (assoc 10 data))
    
20.               pl   (polar p (* 1.25 pi) 15.0)
    
21.               pr   (polar p (* 0.25 pi) 15.0)
    
22.         )
    
23.         (if (not
    
24.               (setq
    
25.                 ent-p (ssget "w" pl pr '((0 . "POINT") (8 . "注记点")))
    
26.               )
    
27.             )
    
28.           (progn (command "layer" "m" "注记点" "c" 3 "注记点" "")
    
29.                  (setq p-point (polar (polar p (* 0.5 pi) 1) pi 1.0))
    
30.                  (command "point" p-point)
    
31.                  (princ ".")
    
32.           )
    
33.         )
    
34.         (setq i (1+ i))
    
35.       )
    
36.       (command "layer" "m" "0" "")
    
37.       (command "zoom" "p")
    
38.     )
    
39.   )
    
40.   (princ "ok")
    
41.   (command ".undo" "E")
    
42.   (princ)
    
43. )[/FONT]

[FONT=courier new]<br /> (defun c:jgcd ()<br />   (command ".undo" "BE")<br />   (setvar "pdmode" 99)<br />   (setvar "pdsize" 20)<br />   (if (setq ent (ssget "x" (list (cons 8 "gcd") (cons 0 "TEXT"))))<br />     (progn<br />       (command "zoom" "e")<br />       (setvar "osmode" 0)<br />       (princ "\n正在给没有点位的高程注记加点位，请稍侯...")<br />       (command "layer" "m" "gcd" "")<br />       (setq long-ent (sslength ent)<br />             i             0<br />       )<br />       (repeat long-ent<br />         (setq ty   (ssname ent i)<br />               data (entget ty)<br />               p           (cdr (assoc 10 data))<br />               pl   (polar p (* 1.25 pi) 15.0)<br />               pr   (polar p (* 0.25 pi) 15.0)<br />         )<br />         (if (not<br />               (setq<br />                 ent-p (ssget "w" pl pr '((0 . "POINT") (8 . "注记点")))<br />               )<br />             )<br />           (progn (command "layer" "m" "注记点" "c" 3 "注记点" "")<br />                  (setq p-point (polar (polar p (* 0.5 pi) 1) pi 1.0))<br />                  (command "point" p-point)<br />                  (princ ".")<br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />       (command "layer" "m" "0" "")<br />       (command "zoom" "p")<br />     )<br />   )<br />   (princ "ok")<br />   (command ".undo" "E")<br />   (princ)<br /> )[/FONT]