[LISP程序]：我写的总平面坐标标注程序

leaveblack · 发表于 2004-5-28 12:23:12

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

适用人群：1、只用CAD不用其他建筑软件的人
2、总平面上坐标点太多，用天正标注会重叠，为此感到郁闷的人

yicai · 发表于 2004-5-31 18:21:41

不知楼主的好不好用，本人也自编了一个，自认为挺好用的，我们单位好多在用。

netbee · 发表于 2004-6-2 21:01:56

下来看看!
我感觉网友们众多的坐标标注都是自已在使用过程中根据自己行业的需要而定制的，所以各有各的优缺点。
因我是搞测绘的，所以我的主要是针对测绘这一块的。可能在其他行业并不实用!
为了节约晓东的资源，请从下面帖子中下载试试吧
http://www.xdcad.net/forum/showthread.php?s=&threadid=193061

自由的鱼 · 发表于 2004-6-18 21:29:02

测绘同行
http://www.xdcad.net/forum/attachment.php?s=&postid=884701

bsycz · 发表于 2004-6-20 10:57:14

怎样安装？

自由的鱼 · 发表于 2004-6-20 12:35:26

最初由 bsycz 发布
[B]怎样安装？ [/B]

将DVB程序加载就可以运行了！加载程序用APPLOAD命令，加载后用VBARUN来运行程序！

841594 · 发表于 2004-7-1 19:50:57

推荐一个很强的坐标标注：
http://www.xdcad.net/forum/showt ... 1100030#post1100030

highlight2004 · 发表于 2004-7-25 15:39:59

怎么不能下

fu2046 · 发表于 2004-8-17 23:39:26

能讲具体点么？

leaveblack · 发表于 2004-9-3 12:12:15

我好改进啊

flychen · 发表于 2004-9-10 22:27:26

我们单位现读用这个呢

烨006 · 发表于 2004-9-26 22:04:26

最初由 leaveblack 发布
[B]适用人群：1、只用CAD不用其他建筑软件的人
2、总平面上坐标点太多，用天正标注会重叠，为此感到郁闷的人 [/B]

很好用！本人推荐这个！

luow · 发表于 2005-12-5 21:54:46

我把字高改到1.5后，字高没变，只是标注线延长了，R14下。
对不起，重新进cad后正常了。
如果楼主能改为标注找空位时有半透明数据跟随鼠标，使用上更为方便。

bluice · 发表于 2007-3-21 08:56:39

好象下不了啊.支持下哈

zml84 · 发表于 2007-3-25 12:37:46

下面这个适用于绘制基桩坐标表（公路专业）

;;;功能：测量并绘制坐标(表格方式)
;;;日期：ZML84 于 2006-08-19
;;;==================================================
(defun c:zb ()
;;命令回显
(setvar "CMDECHO" 0)
(command "undo" "be")
;;捕捉设置
(setq osmode_old (getvar "OSMODE"))
;;参数设置
(if (= 内框颜色 nil)
(progn
(setq 内框颜色 1
文字颜色 2
外框颜色 3
坐标精度 4
)
(setq 表格_高度 6
表格_宽度1
16
表格_宽度2
10
表格_宽度3
25
表头字高 2.5
表中字高 2.0
)
)
)
;;绘制表头
(initget "G g")
(setq pt0 (getpoint "\n请指定表格绘制位置，或者 [改变参数(G)]:"))
(if (or (= pt0 "G") (= pt0 "g"))
(progn
(sz)
(setq pt0 (getpoint "\n请指定表格绘制位置:"))
)
)
(setq pt0_x (car pt0)
pt0_y (cadr pt0)
)
(SETQ PT1 (polar PT0 0 表格_宽度1)
PT3 (polar PT1 0 表格_宽度2)
PT5 (polar PT3 0 表格_宽度3)
PT7 (polar PT5 0 表格_宽度3)
PT2 (polar PT1 (* -0.5 PI) 表格_高度)
PT4 (polar PT3 (* -0.5 PI) 表格_高度)
PT6 (polar PT5 (* -0.5 PI) 表格_高度)
PT8 (polar PT7 (* -0.5 PI) 表格_高度)
PT9 (polar PT0 (* -0.5 PI) 表格_高度)
)
(COMMAND "color" 内框颜色)
(COMMAND "PLINE" PT0 PT7 PT8 PT9 PT0 "")
(COMMAND "PLINE" PT1 PT2 PT4 PT3 PT4 PT6 PT5 PT6 PT8 PT7 "")
(SETQ ZBS1 (entlast))
(SETQ PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0))
PT10 (polar PT10 0 (/ 表格_宽度1 2.0))
)
(COMMAND "color" 文字颜色)
(COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "编号")
(SETQ PT10 (polar PT10 0 (/ (+ 表格_宽度1 表格_宽度2) 2.0)))
(COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "点号")
(SETQ pt11 pt10
PT10 (polar PT10 0 (/ (+ 表格_宽度2 表格_宽度3) 2.0))
)
(COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "坐标（Ｎ）")
(SETQ pt12 pt10
PT10 (polar PT10 0 表格_宽度3)
)
(COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "坐标（Ｅ）")
;;表头绘制完毕
;;下面点取待测点
(SETQ I 1)
(setvar "OSMODE" osmode_old)
(WHILE (/= nil
(SETQ PTI
(GETPOINT (strcat "\n请指定要测量位置<第" (itoa i) "次>:")
)
)
)
;;设置捕捉模式
(setq osmode_old (getvar "OSMODE"))
(setvar "OSMODE" 0)
(COMMAND "COPY" ZBS1 "" pt0 pt9)
(SETQ ZBS1 (entlast)
pt11 (polar PT11 (* -0.5 PI) 表格_高度)
pt12 (polar PT12 (* -0.5 PI) 表格_高度)
pt10 (polar PT10 (* -0.5 PI) 表格_高度)
pti_x (rtos (car PTI) 2 坐标精度)
pti_y (rtos (cadr PTI) 2 坐标精度)
)
(princ (strcat "N(Y)=" pti_y " E(X)=" pti_x))
(COMMAND "TEXT"
"J"
"MC"
PT11
表中字高
0.0
(strcat (itoa i) "#")
)
(COMMAND "TEXT" "J" "MC" PT12 表中字高 0.0 pti_y)
(COMMAND "TEXT" "J" "MC" PT10 表中字高 0.0 pti_x)
(setq i (+ i 1))
(setvar "OSMODE" osmode_old)
)
;;如果记录有坐标数据，就绘制外边框
(if (> i 1)
(progn
;;设置捕捉模式
(setq osmode_old (getvar "OSMODE"))
(setvar "OSMODE" 0)
;;绘制外框
(COMMAND "color" 外框颜色)
(SETQ PT7 (polar PT7 (* -0.5 PI) (* 表格_高度 I)))
(COMMAND "rectang" "W" 0.2 PT0 PT7)
;;编号信息
(setq xxx nil
xxx (getstring T "\n请输入编号信息: ")
)
(if (= xxx "")
(setq xxx "请写编号信息")
)
(setq pt9 (polar PT9 (* -0.5 PI) (* 表格_高度 (- I 1) 0.5))
pt9 (polar PT9 0 (/ 表格_宽度1 2.0))
)
(COMMAND "TEXT" "J" "MC" PT9 表中字高 0.0 xxx)
(princ (strcat "\n操作已完成，共收集到"
(itoa (- i 1))
"个坐标点。"
)
)
)
(princ "\n操作已完成，没有收集到坐标点！！")
)
;;退出处理
(command "undo" "e")
(if (= i 1)
(command "undo" 1)
)
(setvar "OSMODE" osmode_old)
(setvar "CMDECHO" 1)
(princ)
)
;;;===================================================
(defun c:sz ()
(sz)
(princ
"\n键入命令"SZ"可进行坐标测量绘制时用到的参数设置。"
)
(princ)
)
;;;===================================================
;;;设置　　参数
(defun sz ()
(princ "\n设置坐标标注中的参数,请输入选项:")
(princ "\n[第1列宽度(1)")
(princ "/第2列表格宽度(2)")
(princ "/第3列表格宽度(3)")
(princ "/表格高度(4)")
(princ "/表头字高(5)")
(princ "/表中字高(6)")
(princ "/恢复默认值(0)]")
(setq ii (getint "\n请输入选项:")
)
(if (or (= ii nil) (< ii 0) (> ii 6))
(princ "\n参数无改变，设置完成!")
(cond
((= ii 0)
(progn
(setq 内框颜色 1
文字颜色 2
外框颜色 3
坐标精度 4
)
(setq 表格_高度 6
表格_宽度1
16
表格_宽度2
10
表格_宽度3
25
表头字高 2.5
表中字高 2.0
)
(princ "\n参数已全部恢复至默认值。")
)
)
((= ii 1)
(progn (princ (strcat "\n请输入第1列宽度<当前值"
(rtos 表格_宽度1 2 坐标精度)
">:"
)
)
(setq 表格_宽度1_x (getdist))
(if (= 表格_宽度1_x nil)
(princ "第1列宽度无改变!")
(= 表格_宽度1 表格_宽度1_x)
)
)
)
((= ii 2)
(progn (princ (strcat "\n请输入第2列宽度<当前值"
(rtos 表格_宽度2 2 坐标精度)
">:"
)
)
(setq 表格_宽度2_x (getdist))
(if (= 表格_宽度2_x nil)
(princ "第1列宽度无改变!")
(= 表格_宽度2 表格_宽度2_x)
)
)
)
((= ii 3)
(progn (princ (strcat "\n请输入第3\4列宽度<当前值"
(rtos 表格_宽度3 2 坐标精度)
">:"
)
)
(setq 表格_宽度3_x (getdist))
(if (= 表格_宽度3_x nil)
(princ "第3列宽度无改变!")
(= 表格_宽度3 表格_宽度3_x)
)
)
)
((= ii 4)
(progn (princ (strcat "\n请输入表格高度<当前值"
(rtos 表格_高度 2 坐标精度)
">:"
)
)
(setq 表格_高度_x (getdist))
(if (= 表格_高度_x nil)
(princ "表格高度无改变!")
(= 表格_高度表格_高度_x)
)
)
)
((= ii 5)
(progn (princ (strcat "\n请输入表头字高<当前值"
(rtos 表头字高 2 坐标精度)
">:"
)
)
(setq 表头字高_x (getdist))
(if (= 表头字高_x nil)
(princ "表头字高无改变!")
(= 表头字高表头字高_x)
)
)
)
((= ii 6)
(progn (princ (strcat "\n请输入表中字高<当前值"
(rtos 表中字高 2 坐标精度)
">:"
)
)
(setq 表中字高_x (getdist))
(if (= 表中字高_x nil)
(princ "表中字高无改变!")
(= 表中字高表中字高_x)
)
)
)
(t nil)
)
)
(princ)
)
;;;==================================================
;;;以下为加载时提示信息
(princ "\n键入命令"SZ"可进行参数设置。")
(princ "\n键入命令"ZB"可进行坐标测量绘制(表格方式)。")
(princ)

;;;功能：测量并绘制坐标(表格方式) 
;;;日期：ZML84 于 2006-08-19 
;;;================================================== 
(defun c:zb () 
    ;;命令回显 
    (setvar "CMDECHO" 0) 
    (command "undo" "be") 
    ;;捕捉设置   
    (setq osmode_old (getvar "OSMODE")) 
 
    ;;参数设置 
    (if        (= 内框颜色 nil) 
        (progn 
            (setq 内框颜色 1 
                  文字颜色 2 
                  外框颜色 3 
                  坐标精度 4 
            ) 
            (setq 表格_高度 6 
                  表格_宽度1 
                     16 
                  表格_宽度2 
                     10 
                  表格_宽度3 
                     25 
                  表头字高 2.5 
                  表中字高 2.0 
            ) 
        ) 
    ) 
 
    ;;绘制表头 
    (initget "G g") 
    (setq pt0 (getpoint "\n请指定表格绘制位置，或者 [改变参数(G)]:")) 
 
    (if        (or (= pt0 "G") (= pt0 "g")) 
        (progn 
            (sz) 
 
            (setq pt0 (getpoint "\n请指定表格绘制位置:")) 
        ) 
    ) 
    (setq pt0_x        (car pt0) 
          pt0_y        (cadr pt0) 
    ) 
    (SETQ PT1 (polar PT0 0 表格_宽度1) 
          PT3 (polar PT1 0 表格_宽度2) 
          PT5 (polar PT3 0 表格_宽度3) 
          PT7 (polar PT5 0 表格_宽度3) 
          PT2 (polar PT1 (* -0.5 PI) 表格_高度) 
          PT4 (polar PT3 (* -0.5 PI) 表格_高度) 
          PT6 (polar PT5 (* -0.5 PI) 表格_高度) 
          PT8 (polar PT7 (* -0.5 PI) 表格_高度) 
          PT9 (polar PT0 (* -0.5 PI) 表格_高度) 
    ) 
    (COMMAND "color" 内框颜色) 
    (COMMAND "PLINE" PT0 PT7 PT8 PT9 PT0 "") 
    (COMMAND "PLINE" PT1 PT2 PT4 PT3 PT4 PT6 PT5 PT6 PT8 PT7 "") 
    (SETQ ZBS1 (entlast)) 
    (SETQ PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0)) 
          PT10 (polar PT10 0 (/ 表格_宽度1 2.0)) 
    ) 
    (COMMAND "color" 文字颜色) 
    (COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "编  号") 
    (SETQ PT10 (polar PT10 0 (/ (+ 表格_宽度1 表格_宽度2) 2.0))) 
    (COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "点号") 
    (SETQ pt11 pt10 
          PT10 (polar PT10 0 (/ (+ 表格_宽度2 表格_宽度3) 2.0)) 
    ) 
    (COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "坐 标（Ｎ）") 
    (SETQ pt12 pt10 
          PT10 (polar PT10 0 表格_宽度3) 
    ) 
    (COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "坐 标（Ｅ）") 
    ;;表头绘制完毕 
    ;;下面点取待测点 
    (SETQ I 1) 
    (setvar "OSMODE" osmode_old) 
    (WHILE (/= nil 
               (SETQ PTI 
                        (GETPOINT (strcat "\n请指定要测量位置<第" (itoa i) "次>:") 
                        ) 
               ) 
           ) 
        ;;设置捕捉模式 
        (setq osmode_old (getvar "OSMODE")) 
        (setvar "OSMODE" 0) 
        (COMMAND "COPY" ZBS1 "" pt0 pt9) 
        (SETQ ZBS1  (entlast) 
              pt11  (polar PT11 (* -0.5 PI) 表格_高度) 
              pt12  (polar PT12 (* -0.5 PI) 表格_高度) 
              pt10  (polar PT10 (* -0.5 PI) 表格_高度) 
              pti_x (rtos (car PTI) 2 坐标精度) 
              pti_y (rtos (cadr PTI) 2 坐标精度) 
        ) 
        (princ (strcat "N(Y)=" pti_y "  E(X)=" pti_x)) 
 
        (COMMAND "TEXT" 
                 "J" 
                 "MC" 
                 PT11 
                 表中字高 
                 0.0 
                 (strcat (itoa i) "#") 
        ) 
        (COMMAND "TEXT" "J" "MC" PT12 表中字高 0.0 pti_y) 
        (COMMAND "TEXT" "J" "MC" PT10 表中字高 0.0 pti_x) 
        (setq i (+ i 1)) 
        (setvar "OSMODE" osmode_old) 
    ) 
 
 
 
    ;;如果记录有坐标数据，就绘制外边框 
    (if        (> i 1) 
        (progn 
            ;;设置捕捉模式 
            (setq osmode_old (getvar "OSMODE")) 
            (setvar "OSMODE" 0) 
            ;;绘制外框 
            (COMMAND "color" 外框颜色) 
            (SETQ PT7 (polar PT7 (* -0.5 PI) (* 表格_高度 I))) 
            (COMMAND "rectang" "W" 0.2 PT0 PT7) 
            ;;编号信息 
            (setq xxx nil 
                  xxx (getstring T "\n请输入编号信息: ") 
            ) 
            (if        (= xxx "") 
                (setq xxx "请写编号信息") 
            ) 
            (setq pt9 (polar PT9 (* -0.5 PI) (* 表格_高度 (- I 1) 0.5)) 
                  pt9 (polar PT9 0 (/ 表格_宽度1 2.0)) 
            ) 
            (COMMAND "TEXT" "J" "MC" PT9 表中字高 0.0 xxx) 
 
            (princ (strcat "\n操作已完成，共收集到" 
                           (itoa (- i 1)) 
                           "个坐标点。" 
                   ) 
            ) 
        ) 
        (princ "\n操作已完成，没有收集到坐标点！！") 
    ) 
 
    ;;退出处理 
    (command "undo" "e") 
    (if        (= i 1) 
        (command "undo" 1) 
    ) 
    (setvar "OSMODE" osmode_old) 
    (setvar "CMDECHO" 1) 
    (princ) 
) 
 
;;;=================================================== 
(defun c:sz () 
    (sz) 
    (princ 
        "\n键入命令"SZ"可进行坐标测量绘制时用到的参数设置。" 
    ) 
    (princ) 
) 
;;;=================================================== 
;;;设置　　参数 
(defun sz () 
    (princ "\n设置坐标标注中的参数,请输入选项:") 
    (princ "\n[第1列宽度(1)") 
    (princ "/第2列表格宽度(2)") 
    (princ "/第3列表格宽度(3)") 
    (princ "/表格高度(4)") 
    (princ "/表头字高(5)") 
    (princ "/表中字高(6)") 
    (princ "/恢复默认值(0)]") 
    (setq ii (getint "\n请输入选项:") 
    ) 
 
    (if        (or (= ii nil) (< ii 0) (> ii 6)) 
        (princ "\n参数无改变，设置完成!") 
        (cond 
            ((= ii 0) 
             (progn 
                 (setq 内框颜色        1 
                       文字颜色        2 
                       外框颜色        3 
                       坐标精度        4 
                 ) 
                 (setq 表格_高度 6 
                       表格_宽度1 
                          16 
                       表格_宽度2 
                          10 
                       表格_宽度3 
                          25 
                       表头字高        2.5 
                       表中字高        2.0 
                 ) 
                 (princ "\n参数已全部恢复至默认值。") 
             ) 
            ) 
            ((= ii 1) 
             (progn (princ (strcat "\n请输入第1列宽度<当前值" 
                                   (rtos 表格_宽度1 2 坐标精度) 
                                   ">:" 
                           ) 
                    ) 
                    (setq 表格_宽度1_x (getdist)) 
                    (if        (= 表格_宽度1_x nil) 
                        (princ "第1列宽度无改变!") 
                        (= 表格_宽度1 表格_宽度1_x) 
                    ) 
             ) 
            ) 
            ((= ii 2) 
             (progn (princ (strcat "\n请输入第2列宽度<当前值" 
                                   (rtos 表格_宽度2 2 坐标精度) 
                                   ">:" 
                           ) 
                    ) 
                    (setq 表格_宽度2_x (getdist)) 
                    (if        (= 表格_宽度2_x nil) 
                        (princ "第1列宽度无改变!") 
                        (= 表格_宽度2 表格_宽度2_x) 
                    ) 
             ) 
            ) 
            ((= ii 3) 
             (progn (princ (strcat "\n请输入第3\4列宽度<当前值" 
                                   (rtos 表格_宽度3 2 坐标精度) 
                                   ">:" 
                           ) 
                    ) 
                    (setq 表格_宽度3_x (getdist)) 
                    (if        (= 表格_宽度3_x nil) 
                        (princ "第3列宽度无改变!") 
                        (= 表格_宽度3 表格_宽度3_x) 
                    ) 
             ) 
            ) 
            ((= ii 4) 
             (progn (princ (strcat "\n请输入表格高度<当前值" 
                                   (rtos 表格_高度 2 坐标精度) 
                                   ">:" 
                           ) 
                    ) 
                    (setq 表格_高度_x (getdist)) 
                    (if        (= 表格_高度_x nil) 
                        (princ "表格高度无改变!") 
                        (= 表格_高度 表格_高度_x) 
                    ) 
             ) 
            ) 
            ((= ii 5) 
             (progn (princ (strcat "\n请输入表头字高<当前值" 
                                   (rtos 表头字高 2 坐标精度) 
                                   ">:" 
                           ) 
                    ) 
                    (setq 表头字高_x (getdist)) 
                    (if        (= 表头字高_x nil) 
                        (princ "表头字高无改变!") 
                        (= 表头字高 表头字高_x) 
                    ) 
             ) 
            ) 
            ((= ii 6) 
             (progn (princ (strcat "\n请输入表中字高<当前值" 
                                   (rtos 表中字高 2 坐标精度) 
                                   ">:" 
                           ) 
                    ) 
                    (setq 表中字高_x (getdist)) 
                    (if        (= 表中字高_x nil) 
                        (princ "表中字高无改变!") 
                        (= 表中字高 表中字高_x) 
                    ) 
             ) 
            ) 
            (t nil) 
        ) 
    ) 
    (princ) 
) 
 
;;;================================================== 
;;;以下为加载时提示信息 
(princ "\n键入命令"SZ"可进行参数设置。") 
(princ "\n键入命令"ZB"可进行坐标测量绘制(表格方式)。") 
(princ)

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：我写的总平面坐标标注程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

有用过的评价一下吗？

Re: [LISP程序]：我写的总平面坐标标注程序