网上找了一个程序
我从网上找到一个标注界址点的程序，但是不会设置，在运行时总提示“该图无界址点图层，请查证后再执行标注界址点命令!!UNDO 当前设置: 自动 = 开，控制 = 全部，合并 = 是，图层 = 是输入要放弃的操作数目或 [自动(A)/控制(C)/开始(BE)/结束(E)/标记(M)/后退(B)] <1>: End” 不知道是程序的问题还是设置的问题？还望多明示！谢谢！
(defun c:DH ()(dh "")(princ))
(defun c:DHB ()(dh "B")(princ))
(defun DH (db / pd pp ph exy jh sc p cd dh m na tt)
(command "UNDO" "Group") (command "OSNAP" "")
(if (null (tblsearch "LAYER" "OO"))
(prompt "\n该图无界址点图层，请查证后再执行标注界址点命令!!")
(progn
(setq sc (getint "\n标注界址点号，选择比列尺1:<1000> "))
(if (= sc nil) (setq sc 1000))
(setq sc (/ sc 1000.0)pp (ppL))
(if (= db "B") (setq bcd (getpoint "\n坐标表制作基点位置:")))
(setq exy (ppb pp 1000.0) jh (JDH (cadr exy)))
(lay "界址点标示" "7" "" "0.2" "")
(foreach p jh (command "DONUT" sc 0.1 (cadr p) ""))
(lay "界址点号+图幅号" "7" "" "0.2" "")
(command "STYLE" "STAND" "宋体" "" "" "" "" "" "")
(foreach p jh (command "TEXT" (cadr p) (* sc 2) 0 (cadddr p)))
(if (= db "B") (progn(lay "界址点坐标表" "7" "" "0.2" "")
(foreach pd (car exy)(setq m 0tcd (mapcar '+ bcd (list 0 (* 13 sc))))
(foreach p (cdr pd)
(if (> (setq h (car p)) 0)(progn
(setq m (1+ m)cd (cadr (assoc h (cadr exy)))r (cadr p))
(command "TEXT" (mapcar '+ bcd (list (* 3 sc) (* 0.7 sc))) (* sc 2.8) 0 m)
(command "TEXT" (mapcar '+ bcd (list (* 13.5 sc) (* 0.7 sc))) (* sc 2.8) 0 (cadddr (assoc h jh)))
(command "LINE" bcd (mapcar '+ bcd (list (* 102 sc) 0)) "")
(command "TEXT" (mapcar '+ bcd (list (* 37.5 sc) (* 0.7 sc))) (* sc 2.8) 0 (rtos (cadr cd) 2 3))
(command "TEXT" (mapcar '+ bcd (list (* 59.6 sc) (* 0.7 sc))) (* sc 2.8) 0 (rtos (car cd) 2 3))
(if (> (abs r) 0) (command "TEXT" (mapcar '+ bcd (list (* 85 sc) (* -3 sc))) (* sc 2.8) 0 (rtos r 2 3)))
(setq bcd (mapcar '- bcd (list 0 (* 6.5 sc))))
)))
(command "AREA" "e" (car pd))
(setq tt (strcat "宗地面积: " (rtos (getvar "AREA") 2 1) " 平方米"))
(command "TEXT" (mapcar '+ bcd (list (* 5 sc) (* 0.7 sc))) (* sc 2.8) 0 tt)
(command "LINE" (mapcar '+ tcd (list 0 (* -6.5 sc))) (mapcar '+ tcd (list (* 102 sc) (* -6.5 sc))) "")
(command "TEXT" (mapcar '+ tcd (list (* 2 sc) (* -5.2 sc))) (* sc 3) 0 "序号")
(command "TEXT" (mapcar '+ tcd (list (* 19 sc) (* -5.2 sc))) (* sc 3) 0 "点 号")
(command "TEXT" (mapcar '+ tcd (list (* 44 sc) (* -5.2 sc))) (* sc 3) 0 "X")
(command "TEXT" (mapcar '+ tcd (list (* 67 sc) (* -5.2 sc))) (* sc 3) 0 "Y")
(command "TEXT" (mapcar '+ tcd (list (* 84 sc) (* -5.2 sc))) (* sc 3) 0 "半 径")
(command "RECTANG" tcd (mapcar '+ bcd (list (* 102 sc) 0)))
(setq bcd (mapcar '- bcd (list 0 (* 19.5 sc))))
)))
(command "ZOOM" "P" "LAYER" "s" "0" "f" "OO" "")
))
(command "UNDO" "End")
)
(defun JDH (exy / p x y cd xl xr yl yr dh h na eh ed d d1 m n s)
;;承接参数exy: 折点数据表。
;;搜索条件:各折点匹配周围2M内最近的“OO层”界址点号。
;;输出结果:折点数据表（含界址点号）。
(command "LAYER" "on" "OO" "t" "OO" "") (setq xl nil)
(foreach d exy(setq cd (cadr d)y (car cd)x (cadr cd))
(if (= xl nil) (setq xl xyl yxr xyr y))
(setq xl (min x xl)yl (min y yl) xr (max x xr)yr (max y yr))
)
(command "ZOOM" (list (- yl 10) (- xl 10)) (list (+ yr 10) (+ xr 10))"REGEN")
(foreach x exy(setq cd (cadr x)p nil)
(setq s (ssget "C" (mapcar '- cd '(10 10)) (mapcar '+ cd '(10 10))))
(setq n (sslength s)m 0d 2.5)
(while (< m n) (setq na (ssname s m)y (entget na)m (1+ m))
(setq hi (cdr (assoc 10 y))dh (cdr (assoc 1 y)))
(if (= (cdr (assoc 0 y)) "TEXT") (if (= (substr dh 1 1) "J")
(if (/= (cdr (assoc 8 y)) "OO")
(if (< (strlen dh) 7) (command "ERASE" na "")
(if (= (assoc na eh) nil) (setq eh (cons (list na dh hi (cdr (assoc 40 y))) eh)))
)
(if (> (strlen dh) 6) (command "ERASE" na "") (progn
(if (= (assoc na ed) nil) (setq ed (cons (list na dh hi) ed)))
(setq xl (* (strlen dh) 0.95)d1 5.0)
(foreach yl (list '(0 0) (list 0 2) (list xl 2) (list xl 0))
(command "DIST" cd (mapcar '+ hi yl))
(setq d1 (min (getvar "DISTANCE") d1))
)
(if (< d1 d) (setq d d1p na))
))))))
(if p (setq ed (subst (append (assoc p ed) (list (car x))) (assoc p ed) ed)))
)
(setq m ed h '())
(foreach x m(if (cddddr x) (progn (setq d 10.0p nil)
(foreach n (cdddr x) (command "DIST" (cadr (assoc n exy)) (caddr x))
(setq d1 (getvar "DISTANCE"))(if (< d1 d) (setq d d1p n))
)
(setq ed (subst (list (car x) (cadr x) (caddr x) p) (assoc (car x) ed) ed))
)))
(foreach x ed (if (cdddr x) (progn
(setq n (cadddr x)cd (cadr (assoc n exy))dh (strcat (cadr x) "/" (map 0 cd)))
(setq exy (subst (list n cd 1 dh) (assoc n exy) exy)y (assoc dh h)m nil)
(if (not y) (setq h (cons (list dh 1 cd) h))
(progn
(foreach p (cddr y) (command "DIST" cd p) (if (> (getvar "DISTANCE") 0.1) (setq m 1)))
(if m (setq h (subst (append (list dh 2 cd) (cddr y)) y h)))
)))))
(foreach p h(if (cdddr p) (setq h (subst (append (list (car p) 2) (cddr p)) p h))))
(foreach p eh(setq dh (cadr p)d (assoc dh h))
(if d(if (= (cadr d) 2)(command "ERASE" na "")(progn
(setq na (car p)cd (caddr p)hi (cadddr p) x (* (strlen dh) hi 0.35)s 10.0)
(foreach y (list '(0 0) (list 0 hi) (list x hi) (list (* x 2) hi) (list (* x 2) 0) (list x 0))
(command "DIST" (caddr d) (mapcar '+ cd y))
(setq s (min (getvar "DISTANCE") s))
)
(if (> s 5.0)(command "ERASE" na "")
(setq h (subst (list dh 0 (caddr d)) d h))
)))))
(foreach p exy (setq d 0dh "无界址点号")
(if (cddr p)(progn (setq dh (cadddr p)d (cadr (assoc dh h)))
(if (= d 2) (setq dh (strcat dh "重号")))
))
(setq exy (subst (list (car p) (cadr p) d dh) p exy))
)
(setq p exy)
)
标注界址点号，选择比列尺1:<1000>
; 错误: no function definition: PPL 请问：程序中的ppl应该怎样定义？ 05.(if (null (tblsearch "LAYER" "OO"))
06.(prompt "\n该图无界址点图层，请查证后再执行标注界址点命令!!")
这句的意思是：图面没有“00”层。就提示没有界址点图层。。
貌似不是为cass写的呵呵 确实没有“00”图层，加上这个图层后继续运行时又提示“标注界址点号，选择比列尺1:<1000>
; 错误: no function definition: PPL”，请问在这里ppl该如何定义？ 烦请高手给看一下啊！ 没人肯帮个忙吗？ 这个程序能不能有懂得的人修改一下啊？ 本人比较菜，大于三十行的程序看着都晕 这个程序看起来挺难得
页:
[1]
2