[源码]勘丈地籍图绘图程序
本帖最后由 004 于 2014-5-11 02:43 编辑;;;勘丈地籍图绘图程序
;;;wkq00420140420
(setvar "cmdecho" 0)
(if (setq layerE (tblobjname "layer" "004YS"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 4 (cdr ass62))
(progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 4)
(cons 2 "004YS")
)
)
)
;;;(if (setq layerE (tblobjname "layer" "004YS"))
;;;(progn
;;; (setq layerEL (entget layerE))
;;; (if(eq nil (setq ass62 (assoc 62 layerEL)))
;;; (progn
;;;(setq el
;;; (cons
;;; (nth 0 layerEL)
;;; (cons (nth 1 layerEL)
;;; (cons (cons 62 4) (cddr layerEl))
;;; )
;;; )
;;;)
;;;(entmod el)
;;; )
;;; (if (/= 4 (cdr ass62))
;;;(progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
;;; (entmod layerEL)
;;;)
;;; )
;;; )
;;;)
;;;)
(if (setq layerE (tblobjname "layer" "004FJ"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 5 (cdr ass62))
(progn (setq layerEL (subst (cons 62 5) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 5)
(cons 2 "004FJ")
)
)
)
(if (setq layerE (tblobjname "layer" "004GFJ"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 2 (cdr ass62))
(progn (setq layerEL (subst (cons 62 2) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 2)
(cons 2 "004GFJ")
)
)
)
(if (setq layerE (tblobjname "layer" "004QSX"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 1 (cdr ass62))
(progn (setq layerEL (subst (cons 62 1) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 1)
(cons 2 "004QSX")
)
)
)
(if (setq layerE (tblobjname "layer" "004权利人"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 4 (cdr ass62))
(progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 4)
(cons 2 "004权利人")
)
)
)
(if (setq layerE (tblobjname "layer" "004序号"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 4 (cdr ass62))
(progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 4)
(cons 2 "004序号")
)
)
)
(defun c:QD ()
(princ "\n权属线起点")
(setq ss (cadr (ssgetfirst)))
(if (and ss (= (setq ssn (sslength ss)) 1))
(progn
(setq e (ssname ss 0))
(setq el (entget e))
(setq pt (cdr (assoc 10 el)))
(setq pt1 (polar pt (* 0.25 pi) 1))
(setq pt2 (polar pt (* 1.25 pi) 1))
(setq pt3 (polar pt (* 0.75 pi) 1))
(setq pt4 (polar pt (* 1.75 pi) 1))
(grdraw pt1 pt2 1)
(grdraw pt3 pt4 1)
)
(progn
(setq e (car (entsel "\n选择权属线")))
(setq el (entget e))
(setq pt (cdr (assoc 10 el)))
(setq pt1 (polar pt (* 0.25 pi) 1))
(setq pt2 (polar pt (* 1.25 pi) 1))
(setq pt3 (polar pt (* 0.75 pi) 1))
(setq pt4 (polar pt (* 1.75 pi) 1))
(grdraw pt1 pt2 -1)
(grdraw pt3 pt4 -1)
)
)
(princ)
)
(defun c:0 (/ ss)
(setq ss (cadr (ssgetfirst)))
(if ss
'()
(progn
(princ "\n选择要归到0层的对象：")
(setq ss (ssget))
)
)
(if ss
(progn (command "change" ss "" "p" "la" "0" "")
(princ "\n对象已归到0层：")
)
)
(princ)
)
(defun c:sx ()
(setvar "SORTENTS" 0)
(if (setq ss (ssget "x" '((8 . "0"))))
(command "draworder" ss "" "B")
)
(if (setq ss (ssget "x" '((8 . "JZD"))))
(command "draworder" ss "" "B")
)
(if (setq ss (ssget "x" '((8 . "*影像*"))))
(command "draworder" ss "" "B")
)
(princ)
)
(defun c:0s ()
(if (setq ss (ssget "x" '((8 . "0"))))
(command "draworder" ss "" "F")
)
)
(defun c:QSS ()
(setvar "SORTENTS" 0)
(if (setq ss (ssget "x" '((8 . "QSX"))))
(command "draworder" ss "" "F")
)
(princ)
)
(defun c:QSX ()
(setvar "SORTENTS" 0)
(if (setq ss (ssget "x" '((8 . "QSX"))))
(command "draworder" ss "" "B")
)
(if (setq ss (ssget "x" '((8 . "*影像*"))))
(command "draworder" ss "" "B")
)
(princ)
)
(defun c:YS (/ ss)
(princ "\n檐水：")
(setq ss (cadr (ssgetfirst)))
(if (and ss (< (setq ssn (sslength ss)) 3))
(progn
(command "PUTP" "c" "143132" ss "")
)
(progn
(command "DD" "143132")
)
)
(princ)
)
(defun c:FJ (/ ss)
(princ "\n房基：")
(setq ss (cadr (ssgetfirst)))
(if (and ss (< (setq ssn (sslength ss)) 3))
(progn
(command "PUTP" "c" "143133" ss "")
)
(progn
(command "DD" "143133")
)
)
(princ)
)
(defun c:QS (/ ss)
(princ "\n权属线：")
(setq ss (cadr (ssgetfirst)))
(if (and ss (= (setq ssn (sslength ss)) 1))
(progn
(command "PUTP" "c" "143134" ss "")
)
(progn
(command "DD" "143134")
)
)
(princ)
)
(defun c:DK (/ ss)
(princ "\n加固坎：")
(setq ss (cadr (ssgetfirst)))
(if (and ss (< (setq ssn (sslength ss)) 3))
(progn
(command "PUTP" "c" "143135" ss "")
)
(progn
(command "DD" "143135")
)
)
(princ)
)
(defun c:YZ (/ ss)
(princ "\n雨罩：")
(setq ss (cadr (ssgetfirst)))
(if (and ss (< (setq ssn (sslength ss)) 3))
(progn
(command "PUTP" "c" "143130" ss "")
)
(command "DD" "143130")
)
(princ)
)
[源码]勘丈地籍图绘图程序
感谢分享好东西 感谢分享好东西 一早上明经见到有测绘的好源码，顶顶顶 专业测绘人人员 终于有大作了支持 强烈支持 大侠，能根据三角网文件（图形或者数据）查询指定点坐标高程吗 树櫴希德 发表于 2014-5-12 14:34
大侠，能根据三角网文件（图形或者数据）查询指定点坐标高程吗
gzxl有这方面的源码，看他发过的主题 本帖最后由 wkq004 于 2014-5-12 21:30 编辑
树櫴希德 发表于 2014-5-12 14:34
大侠，能根据三角网文件（图形或者数据）查询指定点坐标高程吗
高程点内插程序(已更新)
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100043&extra=&mobile=yes 是个好东西得支持 感谢分享！！！！
页:
[1]
2