[原创]：绝对坐标网格标注（测绘、总图）

xyp1964

功能：在图中生成单位网格线并标注网格的绝对坐标。
[php]
(Defun C:ZBWG (/     pt1   pt2         dx1   dy1   dx2   dy2         pta   ptb
               ptc   ptd   ah         al    pnh1  pnh2  pnv1         pnv2  ss1
              )
  (CMDLA0)
  (GRTEXT -1 "总图以米为单位, 请注意!!!" 1)
  (alert "总图以米为单位, 请注意!!!")
  (while (> bl 2)
    (setq bl nil)
    (setbl)
  )
  (if (= no1 nil)
    (setq no1 20)
  )
  (setq no1 (ureal 1 "" "\n网格间距" no1))
  (while (NOT (setq pt1 (getpoint "\n网格左下角点 : "))))
  (while (NOT (setq pt2 (getcorner pt1 "\n网格右上角点 : ")))
  )
  (if (< (car pt1) 0)
    (setq dx1 (fix (* (- (fix (/ (car pt1) no1)) 1) no1)))
    (setq dx1 (fix (* (fix (/ (car pt1) no1)) no1)))
  )
  (if (< (cadr pt1) 0)
    (setq dy1 (fix (* (- (fix (/ (cadr pt1) no1)) 1) no1)))
    (setq dy1 (fix (* (fix (/ (cadr pt1) no1)) no1)))
  )
  (if (< (car pt2) 0)
    (setq dx2 (fix (* (fix (/ (car pt2) no1)) no1)))
    (setq dx2 (fix (* (+ (fix (/ (car pt2) no1)) 1) no1)))
  )
  (if (< (cadr pt2) 0)
    (setq dy2 (fix (* (fix (/ (cadr pt2) no1)) no1)))
    (setq dy2 (fix (* (+ (fix (/ (cadr pt2) no1)) 1) no1)))
  )

  (setq        pta (list dx1 dy1)
        ptb (list dx2 dy1)
        ptc (list dx2 dy2)
        ptd (list dx1 dy2)
        ah  (fix (+ (/ (- dy2 dy1) no1) 1))
        al  (fix (+ (/ (- dx2 dx1) no1) 1))
  )
  (setvar "osmode" 0)
  (setq        pnh1 (list (car pta) (- (cadr pta) (* 500 sc)))
        pnh2 (list (car ptd) (+ (cadr ptd) (* 500 sc)))
        pnv1 (list (- (car pta) (* 500 sc)) (cadr pta))
        pnv2 (list (+ (car ptb) (* 500 sc)) (cadr pta))
  )
  (jzhz)
  (princ "\n稍候 : ...")
  (while (<= (car pnh1) (car ptb))
    (MKLA "测量坐标3" 3)
    (princ ".")
    (command "text"
             "j"
             "mr"
             pnh1
             (* 300 sc)
             "90"
             (strcat "X=" (itoa (fix (car pnh1))))
    )
    (princ ".")
    (command "text"
             "j"
             "ml"
             pnh2
             (* 300 sc)
             "90"
             (strcat "X=" (itoa (fix (car pnh2))))
    )
    (princ ".")
    (MKLA "测量坐标4" 1)
    (princ ".")
    (command "line" pnh1 pnh2 "")
    (setq pnh1 (list (+ (car pnh1) no1) (cadr pnh1))
          pnh2 (list (+ (car pnh2) no1) (cadr pnh2))
    )
  )

  (while (<= (cadr pnv1) (cadr ptd))
    (MKLA "测量坐标3" 3)
    (princ ".")
    (command "text"
             "j"
             "mr"
             pnv1
             (* 300 sc)
             "0"
             (strcat "Y=" (itoa (fix (cadr pnv1))))
    )
    (princ ".")
    (command "text"
             "j"
             "ml"
             pnv2
             (* 300 sc)
             "0"
             (strcat "Y=" (itoa (fix (cadr pnv2))))
    )
    (princ ".")
    (MKLA "测量坐标4" 1)
    (princ ".")
    (command "line" pnv1 pnv2 "")
    (setq pnv1 (list (car pnv1) (+ (cadr pnv1) no1))
          pnv2 (list (car pnv2) (+ (cadr pnv2) no1))
    )
  )
  (princ ".")
  (command "zoom" "e")
  (princ "完毕!")
  (CMDLA1)
)
(PXYP "ZBWG (坐标网格)")
[/php]

效果：

啵浪鼓

哎呀，又得加上楼主的通用函数了，不想测。。。

xyp1964

如果下载过“通用函数”就不用再下载了！！！

jinsong-liao

"错误: 输入中的点位置不正确"
请问是何原因？楼主请解释一下。

xxming

提示：错误: 输入中的点位置不正确

jinsong-liao

请斑竹回复一下为何会出现上面的错误。

xyp1964

多了个“\”，已在1楼修改。

jinsong-liao

要是XYP1964斑竹能够提供通用函数的源代码，供我们研究学习，那就好了！
毕竟您编写的程序不一定符合各个专业的表达习惯，有点过分的要求。

yubm

需要改进

jinsong-liao

要是增加绘十字网格就更完美了，也就是施工座标网，希望斑竹改进改进！

xyp1964

最初由 jinsong-liao 发布
[B]要是增加绘十字网格就更完美了，也就是施工座标网，希望斑竹改进改进！ [/B]

主意不错，容易实现，有空加上。
主要语句：
(mkla"施工座标网"3)
(xyp_szx pt 200)

武陵山人

xyp 兄，以毫米为单位如何改？

xyp1964

你把标注认为是毫米就行了！

啵浪鼓

最初由 xyp1964 发布
[B]你把标注认为是毫米就行了！ [/B]

此言差矣，怎能当成毫米咧？？？
如果是用于施工或是加工时，加工单位是按照数据来加工而非标注或是注解什么的，那岂非遭糕，可能楼主没遇到过加工类的制品。。。

xyp1964

最初由 啵浪鼓 发布
[B]

此言差矣，怎能当成毫米咧？？？
如果是用于施工或是加工时，加工单位是按照数据来加工而非标注或是注解什么的，那岂非遭糕，?.. [/B]

你以为 1000 这个数字代表1000毫米还是1000米、或者1000公里？