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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 行业篇 › AutoCAD与GIS测绘 › 【求助】如何在cad中生成控制点坐标表【已解决】
123下一页
返回列表 发新帖
查看: 19635|回复: 24

【求助】如何在cad中生成控制点坐标表【已解决】

    [复制链接]
yuanziyou
发表于 2012-12-12 15:51:32 | 显示全部楼层 |阅读模式
本帖最后由 yuanziyou 于 2018-10-3 18:49 编辑

各位搞测绘的高手，谁可以帮忙编写一个在cad中生成控制点坐标表的小程序（直接生成在cad文件中）具体的样式见附件


======================================================================================
感谢gzxl提供的源代码与思路，下面是我整理后的代码，是在gzxl代码的基础上修改了提取点名的部分，表格重新调整了大小，获取的数据可以按点名排序,添加注释,方便学习,共同进步!



cad, 如何

本帖子中包含更多资源

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

x

相关帖子
回复

使用道具 举报

xiabin68
发表于 2012-12-12 18:49:11 | 显示全部楼层
是在CASS下面生成的控制点的话就有办法做，，
回复 支持 反对

使用道具 举报

yuanziyou
 楼主| 发表于 2012-12-12 20:10:11 | 显示全部楼层
xiabin68 发表于 2012-12-12 18:49
是在CASS下面生成的控制点的话就有办法做，，

就是cass，我想直接放在图上，导出到文件的倒是好解决
回复 支持 反对

使用道具 举报

gzxl
发表于 2012-12-12 23:59:39 | 显示全部楼层
yuanziyou 发表于 2012-12-12 20:10
就是cass，我想直接放在图上，导出到文件的倒是好解决

当练练
  2. (defun c:tt ( / i lst lstp osm pt ss)
  3.   (vl-load-com)
  4.   (setq osm (getvar "osmode"))
  5.   (setvar "osmode" 0)
  6.   (if (setq i 0 ss (ssget '((0 . "INSERT") (8 . "KZD"))))
  7.       (progn
  8.          (setq i 0 lstp '())
  9.          (repeat (sslength ss)
  10.             (setq pt   (cdr (assoc 10 (entget (ssname ss i))))
  11.                   lst  (SearchText pt)
  12.                   lstp (cons (append pt (list lst)) lstp)
  13.                   i    (1+ i)
  14.             )
  15.          )
  16.          (if (setq p0 (getpoint "\n指定表格绘制位置:"))
  17.              (progn
  18.                 (if (null p0) (setq p0 '(0 0 0)))
  19.                 (OutputHeader p0)
  20.                 (Outputtable lstp p0)
  21.              )
  22.          )
  23.       )
  24.   )
  25.   (setvar "osmode" osm)
  26.   (princ)
  27. )
  28. (defun SearchText (p / i kzdtext ob px py pz x1 x2 y1 y2)
  29.   (setq px  (car p)
  30.         py  (cadr p)
  31.         pz  (caddr p)
  32.         x1  (- px 4)
  33.         x2  (+ px 4)
  34.         y1  (- py 4)
  35.         y2  (+ py 4)
  36.   )
  37.   (setq ob (ssget "X" (list '(-4 . "<and") '(-4 . ">=,>=,*") (list 10 x1 y1 0) '(-4 . "<=,<=,*") (list 10 x2 y2 0) '(0 . "*TEXT") '(8 . "KZD")  '(-4 . "and>"))))
  38.   (cond
  39.      ((= ob nil) (setq kzdText ""))
  40.      ((= (sslength ob) 1) (setq kzdText (Vlax-Get (vlax-ename->vla-object (ssname ob 0)) 'TextString )))
  41.      ((>= (sslength ob) 2)
  42.         (progn
  43.           (setq i 0)
  44.           (repeat (sslength ob)
  45.             (setq kzdText (Vlax-Get (vlax-ename->vla-object (ssname ob i)) 'TextString ))
  46.             (cond
  47.               ((= (ascii kzdText) 75) (setq kzdText kzdText))
  48.               ;((> (ascii kzdText) 57) (setq kzdText kzdText))
  49.               ((/= (ascii kzdText) 75) (setq kzdText ""))
  50.               ;((<= (ascii kzdText) 57) (setq kzdText ""))
  51.             )
  52.             (setq i (1+ i))
  53.           )
  54.         )
  55.      )
  56.   )
  57.   kzdText
  58. )
  59. (defun OutputHeader (p0 / i k lst p0 p1 p2 p3 p4 p5 p6 ptlst strlst)
  60.    (setq p4 (polar p0 (* 0.5 pi) 6) p5 (polar p4 0 100) p6 (polar p0 0 100))
  61.    (EntmakeLine (list p0 p4 p5 p6 p0))
  62.    (EntmakeText "控制点坐标及高程成果表(单位:m)" (polar p0 (angle p0 p5) (/ (distance p0 p5) 2)))
  63.    (setq i 0 k 4 lst '() ptlst '() strlst '("点名" "北坐标(X)" "东坐标(Y)" "高程(H)"))
  64.    (while (< i k)
  65.       (setq p1    (polar p0 (* -0.5 pi) 6)
  66.             p2    (polar p0 0 25)
  67.             p3    (polar p1 0 25)   
  68.       )
  69.       (EntmakeText (nth i strlst) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
  70.       (setq lst   (cons p0 (cons p1 (cons p3 (cons p2 lst))))
  71.             ptlst (append ptlst lst)
  72.             p0 p2
  73.       )
  74.       (setq i (1+ i))
  75.    )
  76.    (EntmakeLine ptlst)
  77. )
  78. (defun Outputtable (lsp pt / i k p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 vlst)
  79.    (setq i 0 k (length lsp) p0 (polar pt (* -0.5 pi) 6))
  80.    (repeat k      
  81.       (setq vlst  (nth i lsp)
  82.             p1    (polar p0 (* -0.5 pi) 6)
  83.             p2    (polar p0 0 25)
  84.             p3    (polar p1 0 25)
  85.             p4    (polar p0 0 50)
  86.             p5    (polar p4 (* -0.5 pi) 6)
  87.             p6    (polar p0 0 75)
  88.             p7    (polar p6 (* -0.5 pi) 6)
  89.             p8    (polar p0 0 100)
  90.             p9    (polar p8 (* -0.5 pi) 6)
  91.       )
  92.       (EntmakeText (cadddr vlst) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
  93.       (EntmakeLine (list p0 p1 p3 p2 p0))
  94.       (EntmakeText (rtos (car vlst) 2 3) (polar p3 (angle p3 p4) (/ (distance p3 p4) 2)))
  95.       (EntmakeLine (list p2 p3 p5 p4 p2))
  96.       (EntmakeText (rtos (cadr vlst) 2 3) (polar p5 (angle p5 p6) (/ (distance p5 p6) 2)))
  97.       (EntmakeLine (list p4 p5 p7 p6 p4))
  98.       (EntmakeText (rtos (caddr vlst) 2 3) (polar p7 (angle p7 p8) (/ (distance p7 p8) 2)))
  99.       (EntmakeLine (list p6 p7 p9 p8 p6))
  100.       (setq p0 p1)
  101.       (setq i (1+ i))
  102.    )
  103. )
  104. (defun EntmakeText (str pt)
  105.   (entmake (list '(0 . "TEXT") (cons 1 str) (cons 10 pt) (cons 40 2.5) '(71 . 0) '(72 . 4) (cons 11 pt)))
  106. )
  107. (defun EntmakeLine (vertices / elist seg)
  108.   (setq elist
  109.      (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
  110.             (cons 90 (length vertices)) (cons 70 0) (cons 38 (caddr (car vertices)))
  111.      )
  112.   )
  113.   (foreach seg vertices (setq elist (append elist (list (cons 10 seg) (cons 42 0)))))
  114.   (entmake elist)
  115. )


本帖子中包含更多资源

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

x

点评

yuanziyou
相当给力！顶！只是有一点细节：在cad中显示的x（图上的横坐标）其实是测量中的Y坐标（东坐标），cad中显示的y（图上的纵坐标）其实是测量中的X坐标（北坐标)。能不能帮忙再完善下！  发表于 2012-12-13 11:17
回复 支持 反对

使用道具 举报

004
发表于 2012-12-13 00:51:16 | 显示全部楼层
当练练----
回复 支持 反对

使用道具 举报

xiabin68
发表于 2012-12-13 13:10:26 | 显示全部楼层
gzxl 发表于 2012-12-12 23:59
当练练

为什么我用你的程序，生成的表格没有点名呢？？？
回复 支持 反对

使用道具 举报

gzxl
发表于 2012-12-13 13:45:59 | 显示全部楼层
xiabin68 发表于 2012-12-13 13:10
为什么我用你的程序，生成的表格没有点名呢？？？

(= (ascii kzdText) 75)   就是"K"
如果点名字母是其他的，需要修改

点评

yuanziyou
注释掉48行就行了  发表于 2012-12-14 11:32
yuanziyou
可不可不判断是否为字母,直接根据cass中控制点坐标的属性值(点号)生成呢?  发表于 2012-12-14 11:21
回复 支持 反对

使用道具 举报

gzxl
发表于 2012-12-13 13:51:04 | 显示全部楼层
strlst '("点名" "北坐标(X)" "东坐标(Y)" "高程(H)"
换成
strlst '("点名" "东坐标(Y)" "北坐标(X)" "高程(H)"


或者
(EntmakeText (rtos (car vlst) 2 3) (polar p3 (angle p3 p4) (/ (distance p3 p4) 2)))
(EntmakeText (rtos (cadr vlst) 2 3) (polar p5 (angle p5 p6) (/ (distance p5 p6) 2)))
换成
(EntmakeText (rtos (cadr vlst) 2 3) (polar p3 (angle p3 p4) (/ (distance p3 p4) 2)))
(EntmakeText (rtos (car vlst) 2 3) (polar p5 (angle p5 p6) (/ (distance p5 p6) 2)))
回复 支持 反对

使用道具 举报

yuanziyou
 楼主| 发表于 2012-12-13 14:14:28 | 显示全部楼层
gzxl 发表于 2012-12-13 13:51
strlst '("点名" "北坐标(X)" "东坐标(Y)" "高程(H)"
换成
strlst '("点名" "东坐标(Y)" "北坐标(X)" "高 ...

感谢提供！
回复 支持 反对

使用道具 举报

gzxl
发表于 2012-12-14 14:38:17 | 显示全部楼层
yuanziyou 发表于 2012-12-13 14:14
感谢提供！

忘了cass的控制点是有扩展属性的
  2. (defun c:tt ( / i str lstp osm pt ss)
  3.   (vl-load-com)
  4.   (setq osm (getvar "osmode"))
  5.   (setvar "osmode" 0)
  6.   (if (setq i 0 ss (ssget '((0 . "INSERT") (8 . "KZD"))))
  7.       (progn
  8.          (setq i 0 lstp '())
  9.          (repeat (sslength ss)
  10.             (setq pt   (cdr (assoc 10 (entget (ssname ss i))))
  11.                   str  (XdataDh (ssname ss i))
  12.                   lstp (cons (append pt (list str)) lstp)
  13.                   i    (1+ i)
  14.             )
  15.          )
  16.          (if (setq p0 (getpoint "\n指定表格绘制位置:"))
  17.              (progn
  18.                 (if (null p0) (setq p0 '(0 0 0)))
  19.                 (OutputHeader p0)
  20.                 (Outputtable lstp p0)
  21.              )
  22.          )
  23.       )
  24.   )
  25.   (setvar "osmode" osm)
  26.   (princ)
  27. )
  28. (defun XdataDh (vlaObj / i lstAll lstSub safDXFValues safDXFValues strdh)
  29.   (if (= (type vlaObj) 'ENAME)
  30.       (setq vlaObj (vlax-ename->vla-object vlaObj))
  31.   )
  32.   (vla-getxdata vlaObj "" 'safDXFCodes 'safDXFValues)
  33.   (if (and safDXFCodes safDXFValues)
  34.       (progn
  35.          (setq lstDXFCodes (vlax-safearray->list safDXFCodes)
  36.                lstDXFValues (mapcar 'variant-value (vlax-safearray->list safDXFValues))
  37.          )
  38.          (setq i 0)
  39.          (foreach intDXFCode lstDXFCodes
  40.             (if (= intDXFCode 1001)
  41.                 (if lstSub
  42.                    (setq lstAll (cons (reverse lstSub) lstAll)
  43.                          lstSub (list (nth i lstDXFValues))
  44.                    )
  45.                    (setq lstSub (list (nth i lstDXFValues)))
  46.                 )
  47.                 (setq lstSub (cons (nth i lstDXFValues) lstSub))
  48.             )
  49.             (setq i (1+ i))
  50.          )
  51.          (if lstSub (reverse (cons (reverse lstSub) lstAll)))
  52.          (setq strdh (car lstSub))
  53.       )
  54.   )
  55. )
  56. (defun OutputHeader (p0 / i k lst p0 p1 p2 p3 p4 p5 p6 ptlst strlst)
  57.    (setq p4 (polar p0 (* 0.5 pi) 6) p5 (polar p4 0 100) p6 (polar p0 0 100))
  58.    (EntmakeLine (list p0 p4 p5 p6 p0))
  59.    (EntmakeText "控制点坐标及高程成果表(单位:m)" (polar p0 (angle p0 p5) (/ (distance p0 p5) 2)))
  60.    (setq i 0 k 4 lst '() ptlst '() strlst '("点名" "北坐标(X)" "东坐标(Y)" "高程(H)"))
  61.    (while (< i k)
  62.       (setq p1    (polar p0 (* -0.5 pi) 6)
  63.             p2    (polar p0 0 25)
  64.             p3    (polar p1 0 25)   
  65.       )
  66.       (EntmakeText (nth i strlst) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
  67.       (setq lst   (cons p0 (cons p1 (cons p3 (cons p2 lst))))
  68.             ptlst (append ptlst lst)
  69.             p0 p2
  70.       )
  71.       (setq i (1+ i))
  72.    )
  73.    (EntmakeLine ptlst)
  74. )
  75. (defun Outputtable (lsp pt / i k p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 vlst)
  76.    (setq i 0 k (length lsp) p0 (polar pt (* -0.5 pi) 6))
  77.    (repeat k      
  78.       (setq vlst  (nth i lsp)
  79.             p1    (polar p0 (* -0.5 pi) 6)
  80.             p2    (polar p0 0 25)
  81.             p3    (polar p1 0 25)
  82.             p4    (polar p0 0 50)
  83.             p5    (polar p4 (* -0.5 pi) 6)
  84.             p6    (polar p0 0 75)
  85.             p7    (polar p6 (* -0.5 pi) 6)
  86.             p8    (polar p0 0 100)
  87.             p9    (polar p8 (* -0.5 pi) 6)
  88.       )
  89.       (EntmakeText (cadddr vlst) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
  90.       (EntmakeLine (list p0 p1 p3 p2 p0))
  91.       (EntmakeText (rtos (cadr vlst) 2 3) (polar p3 (angle p3 p4) (/ (distance p3 p4) 2)))
  92.       (EntmakeLine (list p2 p3 p5 p4 p2))
  93.       (EntmakeText (rtos (car vlst) 2 3) (polar p5 (angle p5 p6) (/ (distance p5 p6) 2)))
  94.       (EntmakeLine (list p4 p5 p7 p6 p4))
  95.       (EntmakeText (rtos (caddr vlst) 2 3) (polar p7 (angle p7 p8) (/ (distance p7 p8) 2)))
  96.       (EntmakeLine (list p6 p7 p9 p8 p6))
  97.       (setq p0 p1)
  98.       (setq i (1+ i))
  99.    )
  100. )
  101. (defun EntmakeText (str pt)
  102.   (entmake (list '(0 . "TEXT") (cons 1 str) (cons 10 pt) (cons 40 2.5) '(71 . 0) '(72 . 4) (cons 11 pt)))
  103. )
  104. (defun EntmakeLine (vertices / elist seg)
  105.   (setq elist
  106.      (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
  107.             (cons 90 (length vertices)) (cons 70 0) (cons 38 (caddr (car vertices)))
  108.      )
  109.   )
  110.   (foreach seg vertices (setq elist (append elist (list (cons 10 seg) (cons 42 0)))))
  111.   (entmake elist)
  112. )

点评

yuanziyou
我自己又研究了一下，发现获取点名有更简单的方法：直接用entget读取扩展数据，即关联元素为-3后的表，见一楼代码  发表于 2012-12-19 15:28
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-12-23 08:36 , Processed in 0.182138 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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