设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 行业篇 › AutoCAD与GIS测绘 › [源码]勘丈地籍图绘图程序
12下一页
返回列表 发新帖
查看: 4931|回复: 11

[源码]勘丈地籍图绘图程序

  [复制链接]
004
发表于 2014-5-11 02:32:05 | 显示全部楼层 |阅读模式
本帖最后由 004 于 2014-5-11 02:43 编辑




  1. ;;;勘丈地籍图绘图程序
  2. ;;;wkq004  20140420
  3. (setvar "cmdecho" 0)

  5. (if (setq layerE (tblobjname "layer" "004YS"))
  6.   (progn
  7.     (setq layerEL (entget layerE))
  8.     (setq ass62 (assoc 62 layerEL))
  9.     (if  (/= 4 (cdr ass62))
  10.       (progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
  11.        (entmod layerEL)
  12.       )
  13.     )
  14.   )
  15.   (entmake (list '(0 . "LAYER")
  16.      '(100 . "AcDbSymbolTableRecord")
  17.      '(100 . "AcDbLayerTableRecord")
  18.      '(70 . 0)
  19.      '(6 . "Continuous")
  20.      '(62 . 4)
  21.      (cons 2 "004YS")
  22.      )
  23.   )
  24. )
  25. ;;;(if (setq layerE (tblobjname "layer" "004YS"))
  26. ;;;  (progn
  27. ;;;    (setq layerEL (entget layerE))
  28. ;;;    (if  (eq nil (setq ass62 (assoc 62 layerEL)))
  29. ;;;      (progn
  30. ;;;  (setq el
  31. ;;;         (cons
  32. ;;;     (nth 0 layerEL)
  33. ;;;     (cons (nth 1 layerEL)
  34. ;;;           (cons (cons 62 4) (cddr layerEl))
  35. ;;;     )
  36. ;;;         )
  37. ;;;  )
  38. ;;;  (entmod el)
  39. ;;;      )
  40. ;;;      (if (/= 4 (cdr ass62))
  41. ;;;  (progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
  42. ;;;         (entmod layerEL)
  43. ;;;  )
  44. ;;;      )
  45. ;;;    )
  46. ;;;  )
  47. ;;;)
  48. (if (setq layerE (tblobjname "layer" "004FJ"))
  49.   (progn
  50.     (setq layerEL (entget layerE))
  51.     (setq ass62 (assoc 62 layerEL))
  52.     (if  (/= 5 (cdr ass62))
  53.       (progn (setq layerEL (subst (cons 62 5) ass62 layerEL))
  54.        (entmod layerEL)
  55.       )
  56.     )
  57.   )
  58.   (entmake (list '(0 . "LAYER")
  59.      '(100 . "AcDbSymbolTableRecord")
  60.      '(100 . "AcDbLayerTableRecord")
  61.      '(70 . 0)
  62.      '(6 . "Continuous")
  63.      '(62 . 5)
  64.      (cons 2 "004FJ")
  65.      )
  66.   )
  67. )

  69. (if (setq layerE (tblobjname "layer" "004GFJ"))
  70.   (progn
  71.     (setq layerEL (entget layerE))
  72.     (setq ass62 (assoc 62 layerEL))
  73.     (if  (/= 2 (cdr ass62))
  74.       (progn (setq layerEL (subst (cons 62 2) ass62 layerEL))
  75.        (entmod layerEL)
  76.       )
  77.     )
  78.   )

  80.   (entmake (list '(0 . "LAYER")
  81.      '(100 . "AcDbSymbolTableRecord")
  82.      '(100 . "AcDbLayerTableRecord")
  83.      '(70 . 0)
  84.      '(6 . "Continuous")
  85.      '(62 . 2)
  86.      (cons 2 "004GFJ")
  87.      )
  88.   )
  89. )

  91. (if (setq layerE (tblobjname "layer" "004QSX"))
  92.   (progn
  93.     (setq layerEL (entget layerE))
  94.     (setq ass62 (assoc 62 layerEL))
  95.     (if  (/= 1 (cdr ass62))
  96.       (progn (setq layerEL (subst (cons 62 1) ass62 layerEL))
  97.        (entmod layerEL)
  98.       )
  99.     )
  100.   )

  102.   (entmake (list '(0 . "LAYER")
  103.      '(100 . "AcDbSymbolTableRecord")
  104.      '(100 . "AcDbLayerTableRecord")
  105.      '(70 . 0)
  106.      '(6 . "Continuous")
  107.      '(62 . 1)
  108.      (cons 2 "004QSX")
  109.      )
  110.   )
  111. )

  113. (if (setq layerE (tblobjname "layer" "004权利人"))
  114.   (progn
  115.     (setq layerEL (entget layerE))
  116.     (setq ass62 (assoc 62 layerEL))
  117.     (if  (/= 4 (cdr ass62))
  118.       (progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
  119.        (entmod layerEL)
  120.       )
  121.     )
  122.   )
  123.   (entmake (list '(0 . "LAYER")
  124.      '(100 . "AcDbSymbolTableRecord")
  125.      '(100 . "AcDbLayerTableRecord")
  126.      '(70 . 0)
  127.      '(6 . "Continuous")
  128.      '(62 . 4)
  129.      (cons 2 "004权利人")
  130.      )
  131.   )
  132. )

  134. (if (setq layerE (tblobjname "layer" "004序号"))
  135.   (progn
  136.     (setq layerEL (entget layerE))
  137.     (setq ass62 (assoc 62 layerEL))
  138.     (if  (/= 4 (cdr ass62))
  139.       (progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
  140.        (entmod layerEL)
  141.       )
  142.     )
  143.   )
  144.   (entmake (list '(0 . "LAYER")
  145.      '(100 . "AcDbSymbolTableRecord")
  146.      '(100 . "AcDbLayerTableRecord")
  147.      '(70 . 0)
  148.      '(6 . "Continuous")
  149.      '(62 . 4)
  150.      (cons 2 "004序号")
  151.      )
  152.   )
  153. )


  156. (defun c:QD ()
  157.   (princ "\n权属线起点")
  158.   (setq ss (cadr (ssgetfirst)))
  159.   (if (and ss (= (setq ssn (sslength ss)) 1))
  160.     (progn
  161.       (setq e (ssname ss 0))
  162.       (setq el (entget e))
  163.       (setq pt (cdr (assoc 10 el)))
  164.       (setq pt1 (polar pt (* 0.25 pi) 1))
  165.       (setq pt2 (polar pt (* 1.25 pi) 1))
  166.       (setq pt3 (polar pt (* 0.75 pi) 1))
  167.       (setq pt4 (polar pt (* 1.75 pi) 1))
  168.       (grdraw pt1 pt2 1)
  169.       (grdraw pt3 pt4 1)
  170.     )
  171.     (progn
  172.       (setq e (car (entsel "\n选择权属线")))
  173.       (setq el (entget e))
  174.       (setq pt (cdr (assoc 10 el)))
  175.       (setq pt1 (polar pt (* 0.25 pi) 1))
  176.       (setq pt2 (polar pt (* 1.25 pi) 1))
  177.       (setq pt3 (polar pt (* 0.75 pi) 1))
  178.       (setq pt4 (polar pt (* 1.75 pi) 1))
  179.       (grdraw pt1 pt2 -1)
  180.       (grdraw pt3 pt4 -1)
  181.     )
  182.   )
  183.   (princ)
  184. )


  187. (defun c:0 (/ ss)
  188.   (setq ss (cadr (ssgetfirst)))
  189.   (if ss
  190.     '()
  191.     (progn
  192.       (princ "\n选择要归到0层的对象：")
  193.       (setq ss (ssget))
  194.     )
  195.   )
  196.   (if ss
  197.     (progn (command "change" ss "" "p" "la" "0" "")
  198.      (princ "\n对象已归到0层：")
  199.     )
  200.   )
  201.   (princ)
  202. )


  205. (defun c:sx ()
  206.   (setvar "SORTENTS" 0)
  207.   (if (setq ss (ssget "x" '((8 . "0"))))
  208.     (command "draworder" ss "" "B")
  209.   )
  210.   (if (setq ss (ssget "x" '((8 . "JZD"))))
  211.     (command "draworder" ss "" "B")
  212.   )
  213.   (if (setq ss (ssget "x" '((8 . "*影像*"))))
  214.     (command "draworder" ss "" "B")
  215.   )
  216.   (princ)
  217. )

  219. (defun c:0s ()
  220.   (if (setq ss (ssget "x" '((8 . "0"))))
  221.     (command "draworder" ss "" "F")
  222.   )
  223. )

  225. (defun c:QSS ()
  226.   (setvar "SORTENTS" 0)
  227.   (if (setq ss (ssget "x" '((8 . "QSX"))))
  228.     (command "draworder" ss "" "F")
  229.   )
  230.   (princ)
  231. )

  233. (defun c:QSX ()
  234.   (setvar "SORTENTS" 0)
  235.   (if (setq ss (ssget "x" '((8 . "QSX"))))
  236.     (command "draworder" ss "" "B")
  237.   )
  238.   (if (setq ss (ssget "x" '((8 . "*影像*"))))
  239.     (command "draworder" ss "" "B")
  240.   )
  241.   (princ)
  242. )

  244. (defun c:YS (/ ss)
  245.   (princ "\n檐水：")
  246.   (setq ss (cadr (ssgetfirst)))
  247.   (if (and ss (< (setq ssn (sslength ss)) 3))
  248.     (progn
  249.       (command "PUTP" "c" "143132" ss "")
  250.     )
  251.     (progn
  252.       (command "DD" "143132")
  253.     )
  254.   )
  255.   (princ)
  256. )

  258. (defun c:FJ (/ ss)
  259.   (princ "\n房基：")
  260.   (setq ss (cadr (ssgetfirst)))
  261.   (if (and ss (< (setq ssn (sslength ss)) 3))
  262.     (progn
  263.       (command "PUTP" "c" "143133" ss "")
  264.     )
  265.     (progn
  266.       (command "DD" "143133")
  267.     )
  268.   )
  269.   (princ)
  270. )

  272. (defun c:QS (/ ss)
  273.   (princ "\n权属线：")
  274.   (setq ss (cadr (ssgetfirst)))
  275.   (if (and ss (= (setq ssn (sslength ss)) 1))
  276.     (progn
  277.       (command "PUTP" "c" "143134" ss "")
  278.     )
  279.     (progn
  280.       (command "DD" "143134")
  281.     )
  282.   )
  283.   (princ)
  284. )


  287. (defun c:DK (/ ss)
  288.   (princ "\n加固坎：")
  289.   (setq ss (cadr (ssgetfirst)))
  290.   (if (and ss (< (setq ssn (sslength ss)) 3))
  291.     (progn
  292.       (command "PUTP" "c" "143135" ss "")
  293.     )
  294.     (progn
  295.       (command "DD" "143135")
  296.     )
  297.   )
  298.   (princ)
  299. )

  301. (defun c:YZ (/ ss)
  302.   (princ "\n雨罩：")
  303.   (setq ss (cadr (ssgetfirst)))
  304.   (if (and ss (< (setq ssn (sslength ss)) 3))
  305.     (progn
  306.       (command "PUTP" "c" "143130" ss "")
  307.     )
  308.     (command "DD" "143130")
  309.   )
  310.   (princ)
  311. )

程序

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

评分

参与人数 3明经币 +4 金钱 +30 收起 理由
13648893846 + 1 很给力!
gzxl + 1 很给力!
yfy2003 + 2 + 30

查看全部评分

相关帖子
回复

使用道具 举报

f4800
发表于 2020-11-1 11:02:20 | 显示全部楼层
[源码]勘丈地籍图绘图程序
回复 支持 反对

使用道具 举报

wm123456
发表于 2020-12-21 14:40:24 | 显示全部楼层

感谢分享好东西
回复 支持 反对

使用道具 举报

xuhaiguang
发表于 2020-1-13 14:00:40 | 显示全部楼层
感谢分享好东西
回复 支持 反对

使用道具 举报

gzxl
发表于 2014-5-11 08:00:11 | 显示全部楼层
一早上明经见到有测绘的好源码，顶顶顶
回复 支持 反对

使用道具 举报

杜阳
发表于 2014-5-11 08:19:34 | 显示全部楼层
专业测绘人人员 终于有大作了  支持    强烈支持
回复 支持 反对

使用道具 举报

树櫴希德
发表于 2014-5-12 14:34:26 | 显示全部楼层
大侠，能根据三角网文件（图形或者数据）查询指定点坐标高程吗
回复 支持 反对

使用道具 举报

wkq004
发表于 2014-5-12 21:26:14 来自手机 | 显示全部楼层
树櫴希德 发表于 2014-5-12 14:34
大侠，能根据三角网文件（图形或者数据）查询指定点坐标高程吗

gzxl有这方面的源码，看他发过的主题
回复 支持 反对

使用道具 举报

wkq004
发表于 2014-5-12 21:29:12 来自手机 | 显示全部楼层
本帖最后由 wkq004 于 2014-5-12 21:30 编辑
树櫴希德 发表于 2014-5-12 14:34
大侠，能根据三角网文件（图形或者数据）查询指定点坐标高程吗


高程点内插程序(已更新)

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100043&extra=&mobile=yes
回复 支持 反对

使用道具 举报

jxy308
发表于 2014-12-21 22:40:30 来自手机 | 显示全部楼层
是个好东西得支持
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-22 19:59 , Processed in 0.227803 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表