admin 管理员组文章数量: 887007
lisp+等高线点线矛盾检查
(defun c:dxjc()
(setq EnAng 25)
(setq StpAng 30)
(setq StpDis 2.0)
(setq SearchR 5.0)
(setq blc 1)
(setq bz1 0 bz2 0)
(setq mm1 0 mm2 0)
(setq StpDis (* StpDis Blc))
(setq gc (strcat "\n输入高程点所在图层:"))
(setq jqxc (strcat "\n输入计曲线所在图层:"))
(setq sqxc (strcat "\n输入首曲线所在图层:"))
(setq gcd (getstring gc))
(setq jqx (getstring jqxc))
(setq sqx (getstring sqxc))
(setq LaJqx (strcase jqx))
(setq LaSqx (strcase sqx))
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 8 gcd))))
(setq m 0)
(setq l 0)
(if (/= ss nil)
(progn
(while (setq tname (ssname ss m))
(setq ed (entget tname))
(setq zb (cdr (assoc 10 ed)))
(setq z (last (assoc 10 ed)))
(setq Pnt0 zb)
; (command"zoom" "c" zb "30")
(setq Done1 1)
(setq EnDis StpDis)
(while (= Done1 1)
(setq hbpi (* pi (/ enang 180.00000)))
(setq Pnt1 (polar Pnt0 hbpi EnDis))
(SETQ SS1 (SSGET "F" (LIST Pnt0 Pnt1)))
; (setq len1 (sslength ss1))
(setq pnt2 (polar Pnt0 hbpi (- 0 EnDis)))
(SETQ SS2 (SSGET "F" (LIST pnt0 Pnt2)))
; (setq len2 (sslength ss2))
(if (and (/= SS1 nil) (/= ss2 nil));2
(progn
(SETQ LEN (SSLENGTH SS1))
(setq n 0 En1VEL -1000)
(while (< n LEN) ;1
(setq bz1 0)
(setq en1 (ssname SS1 n))
(if (> len 1)
(progn
(setq enbz1 (ssname SS1 1))
(setq SS1ed1 (entget enbz1))
(setq xx1 (cdr (assoc 6 ss1ed1)))
))
(setq SS1ed (entget en1))
(SETQ Lay (CDR (ASSOC 8 SS1ED)))
(setq ename (cdr (assoc 0 ss1ed)))
(if (and (or (= (strcase ename) (strcase "polyline"))
(= (strcase ename) (strcase "lwpolyline")))
(or (= Lay LaJqx) (= Lay LaSqx)))
(progn
(setq bz1 1)
;(command "pline" pnt0 "w" 0.0 0.0 pnt1 "")
(setq entlist (entget en1))
(if (= (strcase ename) (strcase "polyline"))
(setq En1VEL (nth 3 (assoc 10 entlist)))
(setq En1VEL (cdr (assoc 38 entlist)))
)
(setq n LEN)
))
(setq n (+ n 1))
) ;1 (while (< n LEN)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(SETQ LEN (SSLENGTH SS2))
(setq n 0 En2VEL 1000)
(while (< n LEN)
(setq bz2 0)
(setq en2 (ssname SS2 n))
(if (> len 1)
(progn
(setq enbz2 (ssname SS2 1))
(setq SS1ed2 (entget enbz2))
(setq xx2 (cdr (assoc 6 ss1ed2)))
))
(setq SS2ed (entget en2))
(SETQ Lay (CDR (ASSOC 8 SS2ED)))
(setq ename (cdr (assoc 0 ss2ed)))
(if (and (or (= (strcase ename) (strcase "polyline"))
(= (strcase ename) (strcase "lwpolyline")))
(or (= Lay LaJqx) (= Lay LaSqx)))
(progn
(setq bz2 1)
;(command "pline" pnt0 "w" 0.0 0.0 pnt2 "")
(setq entlist (entget en2))
(if (= (strcase ename) (strcase "polyline"))
(setq En2VEL (nth 3 (assoc 10 entlist)))
(setq En2VEL (cdr (assoc 38 entlist)))
)
(setq n LEN)
))
(setq n (+ n 1))
);1 (while (< n LEN)
(if (< en2vel en1vel)
(progn
(setq gczm en1vel)
(setq gczx en2vel)
)
(progn
(setq gczm en2vel)
(setq gczx en1vel)
)
)
(if (or (and (> z gczx) (< z gczm)) (and (= xx1 "921") (= xx2 "921")) (and (= xx1 "922") (= xx2 "922")) (and (= xx1 "921") (= xx2 "922")) (and (/= xx1 "922") (= xx2 "921")))
(setq Done1 2)
(progn
(if (and (or (> z gczm) (< z gczx)) (/= gczx gczm) (/= En2VEL 1000) (/= en1vel -1000) (= bz1 1) (= bz2 1))
(progn
; (command"change" tname "" "p" "la" "0" "")
(command"layer" "s" "0" "c" "1" "" "")
(command"_circle" zb "3")
(setq bz1 0 bz2 0)
(setq l (1+ l))
(setq Done1 2)
)
(progn
(setq EnAng (+ EnAng StpAng))
(if (> EnAng 180)
(progn
(setq endis (+ endis stpdis))
(setq enang 25)
(if (> endis SearchR)
(setq Done1 2))
))))))
)))
(setq m (1+ m))
)
(princ " \n共有[ ")
(princ l)
(princ " ] 处点线矛盾")
(princ)
))
)
本文标签： lisp等高线点线矛盾检查
版权声明：本文标题：lisp+等高线点线矛盾检查 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://www.freenas.com.cn/jishu/1732352263h1533427.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论