网上找了一个程序

tianyuan

我从网上找到一个标注界址点的程序，但是不会设置，在运行时总提示“该图无界址点图层，请查证后再执行标注界址点命令!!UNDO 当前设置: 自动 = 开，控制 = 全部，合并 = 是，图层 = 是
输入要放弃的操作数目或 [自动(A)/控制(C)/开始(BE)/结束(E)/标记(M)/后退(B)] <1>: End”      不知道是程序的问题还是设置的问题？还望多明示！谢谢！

1. (defun c:DH ()  (dh "")  (princ))
   
2. (defun c:DHB ()  (dh "B")  (princ))
   
3. (defun DH (db / pd pp ph exy jh sc p cd dh m na tt)
   
4. (command "UNDO" "Group") (command "OSNAP" "")
   
5. (if (null (tblsearch "LAYER" "OO"))
   
6.   (prompt "\n该图无界址点图层，请查证后再执行标注界址点命令!!")
   
7.   (progn
   
8.    (setq sc (getint "\n标注界址点号，选择比列尺1:<1000> "))
   
9.    (if (= sc nil) (setq sc 1000))
   
10.    (setq sc (/ sc 1000.0)  pp (ppL))
    
11.    (if (= db "B") (setq bcd (getpoint "\n坐标表制作基点位置:")))
    
12.    (setq exy (ppb pp 1000.0)   jh (JDH (cadr exy)))
    
13.    (lay "界址点标示" "7" "" "0.2" "")
    
14.    (foreach p jh (command "DONUT" sc 0.1 (cadr p) ""))
    
15.    (lay "界址点号+图幅号" "7" "" "0.2" "")
    
16.    (command "STYLE" "STAND" "宋体" "" "" "" "" "" "")
    
17.    (foreach p jh (command "TEXT" (cadr p) (* sc 2) 0 (cadddr p)))
    
18.    (if (= db "B") (progn  (lay "界址点坐标表" "7" "" "0.2" "")
    
19.     (foreach pd (car exy)  (setq m 0  tcd (mapcar '+ bcd (list 0 (* 13 sc))))
    
20.      (foreach p (cdr pd)
    
21.       (if (> (setq h (car p)) 0)  (progn
    
22.        (setq m (1+ m)  cd (cadr (assoc h (cadr exy)))  r (cadr p))
    
23.        (command "TEXT" (mapcar '+ bcd (list (* 3 sc) (* 0.7 sc))) (* sc 2.8) 0 m)
    
24.        (command "TEXT" (mapcar '+ bcd (list (* 13.5 sc) (* 0.7 sc))) (* sc 2.8) 0 (cadddr (assoc h jh)))
    
25.        (command "LINE" bcd (mapcar '+ bcd (list (* 102 sc) 0)) "")
    
26.        (command "TEXT" (mapcar '+ bcd (list (* 37.5 sc) (* 0.7 sc))) (* sc 2.8) 0 (rtos (cadr cd) 2 3))
    
27.        (command "TEXT" (mapcar '+ bcd (list (* 59.6 sc) (* 0.7 sc))) (* sc 2.8) 0 (rtos (car cd) 2 3))
    
28.        (if (> (abs r) 0) (command "TEXT" (mapcar '+ bcd (list (* 85 sc) (* -3 sc))) (* sc 2.8) 0 (rtos r 2 3)))
    
29.        (setq bcd (mapcar '- bcd (list 0 (* 6.5 sc))))
    
30.      )))
    
31.      (command "AREA" "e" (car pd))
    
32.      (setq tt (strcat "宗地面积: " (rtos (getvar "AREA") 2 1) " 平方米"))
    
33.      (command "TEXT" (mapcar '+ bcd (list (* 5 sc) (* 0.7 sc))) (* sc 2.8) 0 tt)
    
34.      (command "LINE" (mapcar '+ tcd (list 0 (* -6.5 sc))) (mapcar '+ tcd (list (* 102 sc) (* -6.5 sc))) "")
    
35.      (command "TEXT" (mapcar '+ tcd (list (* 2 sc) (* -5.2 sc))) (* sc 3) 0 "序号")
    
36.      (command "TEXT" (mapcar '+ tcd (list (* 19 sc) (* -5.2 sc))) (* sc 3) 0 "点 号")
    
37.      (command "TEXT" (mapcar '+ tcd (list (* 44 sc) (* -5.2 sc))) (* sc 3) 0 "X")
    
38.      (command "TEXT" (mapcar '+ tcd (list (* 67 sc) (* -5.2 sc))) (* sc 3) 0 "Y")
    
39.      (command "TEXT" (mapcar '+ tcd (list (* 84 sc) (* -5.2 sc))) (* sc 3) 0 "半 径")
    
40.      (command "RECTANG" tcd (mapcar '+ bcd (list (* 102 sc) 0)))
    
41.      (setq bcd (mapcar '- bcd (list 0 (* 19.5 sc))))
    
42.    )))
    
43.    (command "ZOOM" "P"   "LAYER" "s" "0" "f" "OO" "")
    
44. ))
    
45. (command "UNDO" "End")
    
46. )
    
47. (defun JDH (exy / p x y cd xl xr yl yr dh h na eh ed d d1 m n s)
    
48.    ;;  承接参数exy: 折点数据表。
    
49.    ;;  搜索条件:  各折点匹配周围2M内最近的“OO层”界址点号。
    
50.    ;;  输出结果:  折点数据表（含界址点号）。
    
51. (command "LAYER" "on" "OO" "t" "OO" "")   (setq xl nil)
    
52. (foreach d exy  (setq cd (cadr d)  y (car cd)  x (cadr cd))
    
53.   (if (= xl nil) (setq xl x  yl y  xr x  yr y))
    
54.   (setq xl (min x xl)  yl (min y yl) xr (max x xr)  yr (max y yr))
    
55. )
    
56. (command "ZOOM" (list (- yl 10) (- xl 10)) (list (+ yr 10) (+ xr 10))  "REGEN")
    
57. (foreach x exy  (setq cd (cadr x)  p nil)
    
58.   (setq s (ssget "C" (mapcar '- cd '(10 10)) (mapcar '+ cd '(10 10))))
    
59.   (setq n (sslength s)  m 0  d 2.5)
    
60.   (while (< m n) (setq na (ssname s m)  y (entget na)  m (1+ m))
    
61.    (setq hi (cdr (assoc 10 y))  dh (cdr (assoc 1 y)))
    
62.    (if (= (cdr (assoc 0 y)) "TEXT") (if (= (substr dh 1 1) "J")
    
63.     (if (/= (cdr (assoc 8 y)) "OO")
    
64.      (if (< (strlen dh) 7) (command "ERASE" na "")
    
65.       (if (= (assoc na eh) nil) (setq eh (cons (list na dh hi (cdr (assoc 40 y))) eh)))
    
66.      )
    
67.      (if (> (strlen dh) 6) (command "ERASE" na "") (progn
    
68.       (if (= (assoc na ed) nil) (setq ed (cons (list na dh hi) ed)))
    
69.       (setq xl (* (strlen dh) 0.95)  d1 5.0)
    
70.       (foreach yl (list '(0 0) (list 0 2) (list xl 2) (list xl 0))
    
71.        (command "DIST" cd (mapcar '+ hi yl))
    
72.        (setq d1 (min (getvar "DISTANCE") d1))
    
73.       )
    
74.       (if (< d1 d) (setq d d1  p na))
    
75.   ))))))
    
76.   (if p (setq ed (subst (append (assoc p ed) (list (car x))) (assoc p ed) ed)))
    
77. )
    
78. (setq m ed   h '())
    
79. (foreach x m  (if (cddddr x) (progn (setq d 10.0  p nil)
    
80.   (foreach n (cdddr x) (command "DIST" (cadr (assoc n exy)) (caddr x))
    
81.    (setq d1 (getvar "DISTANCE"))  (if (< d1 d) (setq d d1  p n))
    
82.   )
    
83.   (setq ed (subst (list (car x) (cadr x) (caddr x) p) (assoc (car x) ed) ed))
    
84. )))
    
85. (foreach x ed (if (cdddr x) (progn
    
86.   (setq n (cadddr x)  cd (cadr (assoc n exy))  dh (strcat (cadr x) "/" (map 0 cd)))
    
87.   (setq exy (subst (list n cd 1 dh) (assoc n exy) exy)  y (assoc dh h)  m nil)
    
88.   (if (not y) (setq h (cons (list dh 1 cd) h))
    
89.    (progn
    
90.     (foreach p (cddr y) (command "DIST" cd p) (if (> (getvar "DISTANCE") 0.1) (setq m 1)))
    
91.     (if m (setq h (subst (append (list dh 2 cd) (cddr y)) y h)))
    
92. )))))
    
93. (foreach p h  (if (cdddr p) (setq h (subst (append (list (car p) 2) (cddr p)) p h))))
    
94. (foreach p eh  (setq dh (cadr p)  d (assoc dh h))
    
95.   (if d  (if (= (cadr d) 2)  (command "ERASE" na "")  (progn
    
96.    (setq na (car p)  cd (caddr p)  hi (cadddr p)   x (* (strlen dh) hi 0.35)  s 10.0)
    
97.    (foreach y (list '(0 0) (list 0 hi) (list x hi) (list (* x 2) hi) (list (* x 2) 0) (list x 0))
    
98.     (command "DIST" (caddr d) (mapcar '+ cd y))
    
99.     (setq s (min (getvar "DISTANCE") s))
    
100.    )
     
101.    (if (> s 5.0)  (command "ERASE" na "")
     
102.     (setq h (subst (list dh 0 (caddr d)) d h))
     
103. )))))
     
104. (foreach p exy (setq d 0  dh "无界址点号")
     
105.   (if (cddr p)  (progn (setq dh (cadddr p)  d (cadr (assoc dh h)))
     
106.    (if (= d 2) (setq dh (strcat dh "重号")))
     
107.   ))
     
108.   (setq exy (subst (list (car p) (cadr p) d dh) p exy))
     
109. )
     
110. (setq p exy)
     
111. )
     

(defun c:DH ()  (dh "")  (princ))<br /> (defun c:DHB ()  (dh "B")  (princ))<br /> (defun DH (db / pd pp ph exy jh sc p cd dh m na tt)<br /> (command "UNDO" "Group") (command "OSNAP" "")<br /> (if (null (tblsearch "LAYER" "OO"))<br />   (prompt "\n该图无界址点图层，请查证后再执行标注界址点命令!!")<br />   (progn<br />    (setq sc (getint "\n标注界址点号，选择比列尺1:<1000> "))<br />    (if (= sc nil) (setq sc 1000))<br />    (setq sc (/ sc 1000.0)  pp (ppL))<br />    (if (= db "B") (setq bcd (getpoint "\n坐标表制作基点位置:")))<br />    (setq exy (ppb pp 1000.0)   jh (JDH (cadr exy)))<br />    (lay "界址点标示" "7" "" "0.2" "")<br />    (foreach p jh (command "DONUT" sc 0.1 (cadr p) ""))<br />    (lay "界址点号+图幅号" "7" "" "0.2" "")<br />    (command "STYLE" "STAND" "宋体" "" "" "" "" "" "")<br />    (foreach p jh (command "TEXT" (cadr p) (* sc 2) 0 (cadddr p)))<br />    (if (= db "B") (progn  (lay "界址点坐标表" "7" "" "0.2" "")<br />     (foreach pd (car exy)  (setq m 0  tcd (mapcar '+ bcd (list 0 (* 13 sc))))<br />      (foreach p (cdr pd)<br />       (if (> (setq h (car p)) 0)  (progn<br />        (setq m (1+ m)  cd (cadr (assoc h (cadr exy)))  r (cadr p))<br />        (command "TEXT" (mapcar '+ bcd (list (* 3 sc) (* 0.7 sc))) (* sc 2.8) 0 m)<br />        (command "TEXT" (mapcar '+ bcd (list (* 13.5 sc) (* 0.7 sc))) (* sc 2.8) 0 (cadddr (assoc h jh)))<br />        (command "LINE" bcd (mapcar '+ bcd (list (* 102 sc) 0)) "")<br />        (command "TEXT" (mapcar '+ bcd (list (* 37.5 sc) (* 0.7 sc))) (* sc 2.8) 0 (rtos (cadr cd) 2 3))<br />        (command "TEXT" (mapcar '+ bcd (list (* 59.6 sc) (* 0.7 sc))) (* sc 2.8) 0 (rtos (car cd) 2 3))<br />        (if (> (abs r) 0) (command "TEXT" (mapcar '+ bcd (list (* 85 sc) (* -3 sc))) (* sc 2.8) 0 (rtos r 2 3)))<br />        (setq bcd (mapcar '- bcd (list 0 (* 6.5 sc))))<br />      )))<br />      (command "AREA" "e" (car pd))<br />      (setq tt (strcat "宗地面积: " (rtos (getvar "AREA") 2 1) " 平方米"))<br />      (command "TEXT" (mapcar '+ bcd (list (* 5 sc) (* 0.7 sc))) (* sc 2.8) 0 tt)<br />      (command "LINE" (mapcar '+ tcd (list 0 (* -6.5 sc))) (mapcar '+ tcd (list (* 102 sc) (* -6.5 sc))) "")<br />      (command "TEXT" (mapcar '+ tcd (list (* 2 sc) (* -5.2 sc))) (* sc 3) 0 "序号")<br />      (command "TEXT" (mapcar '+ tcd (list (* 19 sc) (* -5.2 sc))) (* sc 3) 0 "点 号")<br />      (command "TEXT" (mapcar '+ tcd (list (* 44 sc) (* -5.2 sc))) (* sc 3) 0 "X")<br />      (command "TEXT" (mapcar '+ tcd (list (* 67 sc) (* -5.2 sc))) (* sc 3) 0 "Y")<br />      (command "TEXT" (mapcar '+ tcd (list (* 84 sc) (* -5.2 sc))) (* sc 3) 0 "半 径")<br />      (command "RECTANG" tcd (mapcar '+ bcd (list (* 102 sc) 0)))<br />      (setq bcd (mapcar '- bcd (list 0 (* 19.5 sc))))<br />    )))<br />    (command "ZOOM" "P"   "LAYER" "s" "0" "f" "OO" "")<br /> ))<br /> (command "UNDO" "End")<br /> )<br /> (defun JDH (exy / p x y cd xl xr yl yr dh h na eh ed d d1 m n s)<br />    ;;  承接参数exy: 折点数据表。<br />    ;;  搜索条件:  各折点匹配周围2M内最近的“OO层”界址点号。<br />    ;;  输出结果:  折点数据表（含界址点号）。<br /> (command "LAYER" "on" "OO" "t" "OO" "")   (setq xl nil)<br /> (foreach d exy  (setq cd (cadr d)  y (car cd)  x (cadr cd))<br />   (if (= xl nil) (setq xl x  yl y  xr x  yr y))<br />   (setq xl (min x xl)  yl (min y yl) xr (max x xr)  yr (max y yr))<br /> )<br /> (command "ZOOM" (list (- yl 10) (- xl 10)) (list (+ yr 10) (+ xr 10))  "REGEN")<br /> (foreach x exy  (setq cd (cadr x)  p nil)<br />   (setq s (ssget "C" (mapcar '- cd '(10 10)) (mapcar '+ cd '(10 10))))<br />   (setq n (sslength s)  m 0  d 2.5)<br />   (while (< m n) (setq na (ssname s m)  y (entget na)  m (1+ m))<br />    (setq hi (cdr (assoc 10 y))  dh (cdr (assoc 1 y)))<br />    (if (= (cdr (assoc 0 y)) "TEXT") (if (= (substr dh 1 1) "J")<br />     (if (/= (cdr (assoc 8 y)) "OO")<br />      (if (< (strlen dh) 7) (command "ERASE" na "")<br />       (if (= (assoc na eh) nil) (setq eh (cons (list na dh hi (cdr (assoc 40 y))) eh)))<br />      )<br />      (if (> (strlen dh) 6) (command "ERASE" na "") (progn<br />       (if (= (assoc na ed) nil) (setq ed (cons (list na dh hi) ed)))<br />       (setq xl (* (strlen dh) 0.95)  d1 5.0)<br />       (foreach yl (list '(0 0) (list 0 2) (list xl 2) (list xl 0))<br />        (command "DIST" cd (mapcar '+ hi yl))<br />        (setq d1 (min (getvar "DISTANCE") d1))<br />       )<br />       (if (< d1 d) (setq d d1  p na))<br />   ))))))<br />   (if p (setq ed (subst (append (assoc p ed) (list (car x))) (assoc p ed) ed)))<br /> )<br /> (setq m ed   h '())<br /> (foreach x m  (if (cddddr x) (progn (setq d 10.0  p nil)<br />   (foreach n (cdddr x) (command "DIST" (cadr (assoc n exy)) (caddr x))<br />    (setq d1 (getvar "DISTANCE"))  (if (< d1 d) (setq d d1  p n))<br />   )<br />   (setq ed (subst (list (car x) (cadr x) (caddr x) p) (assoc (car x) ed) ed))<br /> )))<br /> (foreach x ed (if (cdddr x) (progn<br />   (setq n (cadddr x)  cd (cadr (assoc n exy))  dh (strcat (cadr x) "/" (map 0 cd)))<br />   (setq exy (subst (list n cd 1 dh) (assoc n exy) exy)  y (assoc dh h)  m nil)<br />   (if (not y) (setq h (cons (list dh 1 cd) h))<br />    (progn<br />     (foreach p (cddr y) (command "DIST" cd p) (if (> (getvar "DISTANCE") 0.1) (setq m 1)))<br />     (if m (setq h (subst (append (list dh 2 cd) (cddr y)) y h)))<br /> )))))<br /> (foreach p h  (if (cdddr p) (setq h (subst (append (list (car p) 2) (cddr p)) p h))))<br /> (foreach p eh  (setq dh (cadr p)  d (assoc dh h))<br />   (if d  (if (= (cadr d) 2)  (command "ERASE" na "")  (progn<br />    (setq na (car p)  cd (caddr p)  hi (cadddr p)   x (* (strlen dh) hi 0.35)  s 10.0)<br />    (foreach y (list '(0 0) (list 0 hi) (list x hi) (list (* x 2) hi) (list (* x 2) 0) (list x 0))<br />     (command "DIST" (caddr d) (mapcar '+ cd y))<br />     (setq s (min (getvar "DISTANCE") s))<br />    )<br />    (if (> s 5.0)  (command "ERASE" na "")<br />     (setq h (subst (list dh 0 (caddr d)) d h))<br /> )))))<br /> (foreach p exy (setq d 0  dh "无界址点号")<br />   (if (cddr p)  (progn (setq dh (cadddr p)  d (cadr (assoc dh h)))<br />    (if (= d 2) (setq dh (strcat dh "重号")))<br />   ))<br />   (setq exy (subst (list (car p) (cadr p) d dh) p exy))<br /> )<br /> (setq p exy)<br /> )<br />

tianyuan

标注界址点号，选择比列尺1:<1000>
; 错误: no function definition: PPL

tianyuan

请问：程序中的ppl应该怎样定义？

yanshengjiang

05.(if (null (tblsearch "LAYER" "OO"))
06.  (prompt "\n该图无界址点图层，请查证后再执行标注界址点命令!!")

这句的意思是：图面没有“00”层。就提示没有界址点图层。。
貌似不是为cass写的  呵呵

tianyuan

确实没有“00”图层，加上这个图层后继续运行时又提示“标注界址点号，选择比列尺1:<1000>
; 错误: no function definition: PPL”，请问在这里ppl该如何定义？

tianyuan

烦请高手给看一下啊！

tianyuan

没人肯帮个忙吗？

tianyuan

这个程序能不能有懂得的人修改一下啊？[em0]

革天明

本人比较菜，大于三十行的程序看着都晕

pslstar

这个程序看起来挺难得