求助自动将坐标表格放入图中

cjf160204

yaokui25 发表于 2014-7-7 11:12
楼主不好意思
手机上网，地址贴错了
http://bbs.mjtd.com/thread-109223-1-1.html

这个好像就是xy是相反的

zmzk

收藏了！有一天可能会用到

祸害一生

xyp1964 发表于 2014-7-6 21:42

对于需要说明控制点坐标的情况很实用

cjf160204

(defun c:zb (/ dcl_id dcl_file result mode)
  (setq mode "POINTS")

  (setq dcl_file (vl-filename-mktemp "zb_dialog.dcl"))
  (setq dcl_handle (open dcl_file "w"))

  (write-line
    "zb_dlg : dialog {
      label = \"标注工具\";
      : row {
        : boxed_radio_column {
          label = \"标注模式\";
          : radio_button {
            label = \"逐点标注\";
            key = \"mode_points\";
            value = 1;
          }
          : radio_button {
            label = \"多段线顶点标注\";
            key = \"mode_poly\";
          }
        }
      }
      spacer;
      ok_cancel;
    }"
    dcl_handle
  )

  (close dcl_handle)
  (setq dcl_id (load_dialog dcl_file))

  (if (not (new_dialog "zb_dlg" dcl_id))
    (exit)
  )

  (set_tile "mode_points" "1")

  (action_tile "mode_points" "(setq mode \"POINTS\")")
  (action_tile "mode_poly" "(setq mode \"POLY\")")

  (action_tile "accept" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")

  (setq result (start_dialog))
  (unload_dialog dcl_id)
  (vl-file-delete dcl_file)

  (if (= result 1)
    (if (= mode "POINTS")
      (zb-points)
      (zb-polyline)
    )
  )

  (princ)
)

;; 创建表格的通用函数
(defun create-coord-table (pt-list prefix tHt / actDoc mSp vlaTab i row_count)
  (vl-load-com)
  (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        mSp (vla-get-ModelSpace actDoc)
        row_count (length pt-list)
        vlaTab (vla-AddTable mSp (vlax-3D-point '(0 0 0)) (+ row_count 1) 3 (* tHt 1.5) (* tHt 20)))

  ;; 设置表头 - 三个独立的单元格
  (vla-SetText vlaTab 0 0 "点号")
  (vla-SetText vlaTab 0 1 "Y")
  (vla-SetText vlaTab 0 2 "X")

  ;; 设置表格数据
  (setq i 0)
  (foreach pt pt-list
    (setq i (1+ i))
    (vla-SetText vlaTab i 0 (strcat prefix (itoa i)))
    (vla-SetText vlaTab i 1 (rtos (cadr pt) 2 3))
    (vla-SetText vlaTab i 2 (rtos (car pt) 2 3))

    ;; 设置单元格样式
    (vla-SetCellTextHeight vlaTab i 0 tHt)
    (vla-SetCellTextHeight vlaTab i 1 tHt)
    (vla-SetCellTextHeight vlaTab i 2 tHt)
    (vla-SetCellAlignment vlaTab i 0 acMiddleCenter)
    (vla-SetCellAlignment vlaTab i 1 acMiddleCenter)
    (vla-SetCellAlignment vlaTab i 2 acMiddleCenter)
  )

  ;; 设置表头样式
  (vla-SetCellTextHeight vlaTab 0 0 tHt)
  (vla-SetCellTextHeight vlaTab 0 1 tHt)
  (vla-SetCellTextHeight vlaTab 0 2 tHt)
  (vla-SetCellAlignment vlaTab 0 0 acMiddleCenter)
  (vla-SetCellAlignment vlaTab 0 1 acMiddleCenter)
  (vla-SetCellAlignment vlaTab 0 2 acMiddleCenter)

  ;; 设置表格尺寸
  (vla-SetColumnWidth vlaTab 0 (* tHt 5))
  (vla-SetColumnWidth vlaTab 1 (* tHt 7.5))
  (vla-SetColumnWidth vlaTab 2 (* tHt 7.5))

  (vla-put-VertCellMargin vlaTab (* tHt 0.35))
  (vla-put-Height vlaTab (* (* tHt 1.5) (+ row_count 1)))

  ;; 移动表格到指定位置
  (princ "\n选择表格位置: ")
  (command "_.copybase" (trans '(0 0 0) 1 0) (entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)

  vlaTab
)

(defun zb-points (/ pt tHt prefix pt_list)
  (vl-load-com)
  (setq pt_list '())

  (setq tHt (getreal "\n请输入文字高度 (默认值为2.5): "))
  (if (not tHt) (setq tHt 2.5))

  (setq prefix (getstring T "\n点号前缀: "))
  (if (not prefix) (setq prefix ""))

  (setq pt (getpoint "\n选择第一个点："))
  (while pt
    (setq pt_list (cons pt pt_list))
    (command "text" "J" "MC" pt tHt 0 (strcat prefix (itoa (length pt_list))))
    (command "circle" pt (/ tHt 15))
    (setq pt (getpoint "\n选择下一个点："))
  )

  (if (null pt_list)
    (progn
      (princ "\n未选择点。")
      (exit)
    )
  )

  ;; 创建表格
  (create-coord-table (reverse pt_list) prefix tHt)

  (princ)
)

(defun zb-polyline (/ pl_ent tHt prefix vlaPl coords pt_list i)
  (vl-load-com)

  (setq tHt (getreal "\n请输入文字高度 (默认值为2.5): "))
  (if (not tHt) (setq tHt 2.5))

  (setq prefix (getstring T "\n点号前缀: "))
  (if (not prefix) (setq prefix ""))

  (while (not (setq pl_ent (car (entsel "\n选择多段线: ")))))

  (if (not (wcmatch (cdr (assoc 0 (entget pl_ent))) "*POLYLINE"))
    (progn
      (princ "\n所选对象不是多段线。")
      (exit)
    )
  )

  (setq vlaPl (vlax-ename->vla-object pl_ent)
        pt_list '()
        i 0)

  ;; 正确获取多段线顶点坐标
  (setq coords (vlax-get vlaPl 'Coordinates))
  (repeat (/ (length coords) 2)
    (setq pt_list (cons (list (nth i coords) (nth (1+ i) coords)) pt_list))
    (setq i (+ i 2))
  )

  (setq pt_list (reverse pt_list))

  ;; 标注每个顶点
  (setq i 0)
  (foreach pt pt_list
    (setq i (1+ i))
    (command "text" "J" "MC" pt tHt 0 (strcat prefix (itoa i)))
    (command "circle" pt (/ tHt 15))
  )

  ;; 创建表格
  (create-coord-table pt_list prefix tHt)

  (princ)
)

(princ "\nZB命令已加载。输入 ZB 开始使用。")
(princ)