CAD中用宗地線提取佔用的房屋線型別
房地一體中填寫界址標示表，需宗地每條線識別其壓蓋的房屋線（JMD）型別
注：宗地線需要轉為多段線
沒有找到Vlisp風格樣式
(princ "\n 只保留JZD和JMD圖層，先limits命令設定範圍，再關閉捕捉功能。命令：JXLX")
(defun c:jxlx()
(setq ents (ssget "x" (list '(8 . "JZD") '(0 . "LWPOLYLINE" ))))
(print (sslength ents))
(setq m 0)
(setq f (getfiled "指定輸出檔案路徑" "" "xls" 1) f (open f "w"))
(repeat (sslength ents)
(setq ss (ssname ents m))
(command "_zoom" "o" ss)
(command "")
(setq hbh1 (entget ss '("*")))
(setq hbhend (cdr (assoc 1000 (cdr(cdr(assoc "SOUTH" (cdr (assoc -3 hbh1))))))))
(setq endata (entget ss))
(setq daochu (strcat "A" hbhend "\t"))
;(print daochu)
(setq xx1 0.0)
(setq yy1 0.0)
(setq n 0)
(repeat (length endata)
(setq zbiao (nth n endata))
(if (= 10 (car zbiao))
(progn
(if(= yy1 xx1)
(progn
(setq xx1 (car(cdr zbiao)))
(setq yy1 (car(cdr(cdr zbiao))))
(setq xx2 (car(cdr zbiao)))
(setq yy2 (car(cdr(cdr zbiao))))
)
(progn
(setq xx3 (car(cdr zbiao)))
(setq yy3 (car(cdr(cdr zbiao))))
(setq cd (rtos(sqrt(+(expt(- xx3 xx2) 2) (expt(- yy3 yy2) 2)))2 2))
(setq xx4 (+ xx2 (/ (- xx3 xx2) 2.0)))
(setq yy4 (+ yy2 (/ (- yy3 yy2) 2.0)))
(if(< 0.01 (abs (- (abs (- xx3 xx2)) (abs (- yy3 yy2)))))
(progn
(setq pt1 (list (- xx4 0.02) (- yy4 0.02)))
(setq pt2 (list (+ xx4 0.02) (+ yy4 0.02)))
)
(progn
(setq pt1 (list (- xx4 0.03) (- yy4 0.02)))
(setq pt2 (list (+ xx4 0.03) (+ yy4 0.02)))
)
)
(setq enjmd nil)
(setq enjmd (ssget "c" pt1 pt2 '((8 . "JMD"))))
(setq enjmd (ssget "c" pt1 pt2 '((8 . "JMD"))))
;(princ enjmd)
(if (/= (type enjmd) (type ents)) ;(= (ssname enjmd 0) nil)
(progn
(setq lxjmd "JZX")
;(print lxjmd)
)
(progn
(setq enjmd1 (ssname enjmd 0))
(setq enjmd2 (entget enjmd1 '("*")))
(setq lxjmd (cdr(assoc 1000 (cdr(assoc "SOUTH" (cdr(assoc -3 enjmd2)))))))
)
)
(setq daochu (strcat daochu cd "\t" lxjmd "\t"))
(setq xx2 xx3)
(setq yy2 yy3)
)
)
)
)
(if (= n (- (length endata) 1))
(progn
(setq xx3 xx1)
(setq yy3 yy1)
(setq cd (rtos(sqrt(+(expt(- xx3 xx2) 2) (expt(- yy3 yy2) 2)))2 2))
(setq xx4 (+ xx2 (/ (- xx3 xx2) 2.0)))
(setq yy4 (+ yy2 (/ (- yy3 yy2) 2.0)))
(if(< 0.01 (abs (- (abs (- xx3 xx2)) (abs (- yy3 yy2)))))
(progn
(setq pt1 (list (- xx4 0.02) (- yy4 0.02)))
(setq pt2 (list (+ xx4 0.02) (+ yy4 0.02)))
)
(progn
(setq pt1 (list (- xx4 0.03) (- yy4 0.02)))
(setq pt2 (list (+ xx4 0.03) (+ yy4 0.02)))
)
)
(setq enjmd nil)
(setq enjmd (ssget "c" pt1 pt2 '((8 . "JMD"))))
(setq enjmd (ssget "c" pt1 pt2 '((8 . "JMD"))))
(if (/= (type enjmd) (type ents)) ;(= (ssname enjmd 0) nil)
(progn
(setq lxjmd "JZX")
)
(progn
(setq enjmd1 (ssname enjmd 0))
(setq enjmd2 (entget enjmd1 '("*")))
(setq lxjmd (cdr(assoc 1000 (cdr(assoc "SOUTH" (cdr(assoc -3 enjmd2)))))))
)
)
(setq daochu (strcat daochu cd "\t" lxjmd "\t"))
)
)
(setq n (+ n 1))
)
(write-line daochu f)
;(print daochu)
(setq m (+ m 1))
)
(close f)
(princ)
)