ZZXXQQ版主请进

tianyuan 发表于 2013-1-25 10:39:01

本帖最后由 tianyuan 于 2013-1-25 22:43 编辑

万分感谢版主，能在百忙之中抽出时间修改程序，这个程序在执行时还是有些问题的，
(setvar "CMDECHO" 0);;命令回显
(command "undo" "be")
(setq osmode_old (getvar "OSMODE"));;捕捉设置
;;参数设置
(if (= 内框颜色 nil)
(setq 内框颜色 1
   文字颜色 2
   外框颜色 3
   坐标精度 3
   表格_高度 6
   表格_宽度1 16
   表格_宽度2 10
   表格_宽度3 25
   表头字高 2.5
   表中字高 2.0
)
)
;;绘制表头
(initget "G")
(setq pt0 (getpoint "\n请指定表格绘制位置，或者 [改变参数(G)]:"))
(if (= 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)
   PT701 (polar PT7 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) 表格_高度)
   PT801 (polar PT701 (* -0.5 PI) 表格_高度)
   PT9 (polar PT0 (* -0.5 PI) 表格_高度))
(command "color" 内框颜色)
(setvar "OSMODE" 0)
(command "PLINE" PT0 PT701 PT801 PT9 PT0 "")
(command "PLINE" PT1 PT2 PT4 PT3 PT4 PT6 PT5 PT6 PT8 PT7 pt8 pt801 pt701 "")
(setq ZBS1 (entlast))
(setq PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0))
   PT10 (polar PT10 0 (/ 表格_宽度1 2.0)))
(setq PT11 (polar PT10 0 (/ (+ 表格_宽度1 表格_宽度2) 2.0))
   PT12 (polar PT11 0 (/ (+ 表格_宽度2 表格_宽度3) 2.0))
   PT13 (polar PT12 0 表格_宽度3)
   PT14 (polar PT13 0 表格_宽度3))
(command "color" 文字颜色)
; (command "TEXT" "MC" PT10 表头字高 0.0 "编号")
; (command "TEXT" "MC" PT11 表头字高 0.0 "点号")
; (command "TEXT" "MC" PT12 表头字高 0.0 "坐标（X）")
; (command "TEXT" "MC" PT13 表头字高 0.0 "坐标（Y）")
; (command "TEXT" "MC" PT14 表头字高 0.0 "坐标（Z）")
(command "TEXT" "MC" PT10 表头字高 0.0 "点号")
(command "TEXT" "MC" PT11 表头字高 0.0 "边长（D）")
(command "TEXT" "MC" PT12 表头字高 0.0 "坐标（X）")
(command "TEXT" "MC" PT13 表头字高 0.0 "坐标（Y）")
(setvar "OSMODE" osmode_old)
;;表头绘制完毕
;;下面点取PL线
(princ "\n选择复线 :")
(if (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE")))) (progn
(setq I 1 plst (list))
(setq ent (entget (ssname ss 0)))
(foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq plst (reverse plst))
(setq dlst (list) j 0)
(repeat (1- (length plst))
(setq dlst
(append dlst (list (distance (nth j plst) (nth (1+ j) plst))))
)
(setq j (1+ j))
)
(setq dlst (append dlst (list (distance (car plst) (last plst)))))
(setq j 0)
(foreach x plst
(setq pti x)
(command "COPY" ZBS1 "" "non" pt0 "non" pt9)
(setq ZBS1(entlast)
      pt11(polar PT11 (* -0.5 PI) 表格_高度)
      pt12(polar PT12 (* -0.5 PI) 表格_高度)
      pt13(polar PT13 (* -0.5 PI) 表格_高度)
      pt14(polar PT14 (* -0.5 PI) 表格_高度)
      pti_x (rtos (car PTI) 2 坐标精度)
      pti_y (rtos (cadr PTI) 2 坐标精度)
      pti_d (rtos (nth j dlst) 2 坐标精度)
      j (1+ j))
(princ (strcat "\nD=" pti_d "X=" pti_y "Y=" pti_x))
(command "TEXT" "MC" "non" PT10 表中字高 0.0 (strcat "J" (itoa i)))
(command "TEXT" "MC" "non" PT11 表中字高 0.0 pti_d)
(command "TEXT" "MC" "non" PT12 表中字高 0.0 pti_x)
(command "TEXT" "MC" "non" PT13 表中字高 0.0 pti_y)
(setq i (1+ i))
)
(setq PT701 (polar PT701 (* 0.5 PI) (* 表格_高度 I)))
(command "color" 外框颜色 "rectang" "W" 0.2 "non" PT0 "non" PT701)
;;编号信息
;(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" "MC" "non" PT9 表中字高 0.0 xxx)
(princ (strcat "\n操作已完成，共收集到" (itoa (1- i)) "个坐标点。"))
))
;;退出处理
(command "undo" "e")
(if (= i 1) (command "undo" 1))
(princ)
)

xiabin68 发表于 2013-1-25 11:51:50

帮顶一下，，，，，，

ZZXXQQ 发表于 2013-1-25 18:59:01

;改了，未调试

(defun c:zb ()
(setvar "CMDECHO" 0);;命令回显
(command "undo" "be")
(setq osmode_old (getvar "OSMODE"));;捕捉设置
;;参数设置
(if (= 内框颜色 nil)
(setq 内框颜色 1
   文字颜色 2
   外框颜色 3
   坐标精度 3
   表格_高度 6
   表格_宽度1 16
   表格_宽度2 10
   表格_宽度3 25
   表头字高 2.5
   表中字高 2.0
)
)
;;绘制表头
(initget "G")
(setq pt0 (getpoint "\n请指定表格绘制位置，或者 [改变参数(G)]:"))
(if (= pt0 "G") (progn
(sz)
(setq pt0 (getpoint "\n请指定表格绘制位置:"))
))
(setq pt0_x (car pt0)
   pt0_y (cadr pt0))
(setq PT1 (polar PT0 0 表格_宽度2)
   PT3 (polar PT1 0 表格_宽度3)
   PT5 (polar PT3 0 表格_宽度3)
   PT7 (polar PT5 0 表格_宽度3)
;    PT701 (polar PT7 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) 表格_高度)
;    PT801 (polar PT701 (* -0.5 PI) 表格_高度)
   PT9 (polar PT0 (* -0.5 PI) 表格_高度))
(command "color" 内框颜色)
(setvar "OSMODE" 0)
(command "PLINE" PT0 PT7 PT8 PT9 "C")
(command "PLINE" PT1 PT2 PT4 PT3 PT4 PT6 PT5 PT6 PT8 PT7 pt8 "")
(setq ZBS1 (entlast))
(setq PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0))
   PT10 (polar PT10 0 (/ 表格_宽度1 2.0)))
(setq PT11 (polar PT10 0 (/ (+ 表格_宽度2 表格_宽度3) 2.0))
   PT12 (polar PT11 0 表格_宽度3)
   PT13 (polar PT12 0 表格_宽度3))
(command "color" 文字颜色)
; (command "TEXT" "MC" PT10 表头字高 0.0 "编号")
; (command "TEXT" "MC" PT11 表头字高 0.0 "点号")
; (command "TEXT" "MC" PT12 表头字高 0.0 "坐标（X）")
; (command "TEXT" "MC" PT13 表头字高 0.0 "坐标（Y）")
; (command "TEXT" "MC" PT14 表头字高 0.0 "坐标（Z）")
(command "TEXT" "MC" PT10 表头字高 0.0 "点号")
(command "TEXT" "MC" PT11 表头字高 0.0 "边长（D）")
(command "TEXT" "MC" PT12 表头字高 0.0 "坐标（X）")
(command "TEXT" "MC" PT13 表头字高 0.0 "坐标（Y）")
(setvar "OSMODE" osmode_old)
;;表头绘制完毕
;;下面点取PL线
(princ "\n选择复线 :")
(if (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE")))) (progn
(setq I 1 plst (list))
(setq ent (entget (ssname ss 0)))
(foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq plst (reverse plst))
(setq dlst (list) j 0)
(repeat (1- (length plst))
(setq dlst
(append dlst (list (distance (nth j plst) (nth (1+ j) plst))))
)
(setq j (1+ j))
)
(setq dlst (append dlst (list (distance (car plst) (last plst)))))
(setq j 0)
(foreach x plst
(setq pti x)
(command "COPY" ZBS1 "" "non" pt0 "non" pt9)
(setq ZBS1(entlast)
      pt10(polar PT10 (* -0.5 PI) 表格_高度)
      pt11(polar PT11 (* -0.5 PI) 表格_高度)
      pt12(polar PT12 (* -0.5 PI) 表格_高度)
      pt13(polar PT13 (* -0.5 PI) 表格_高度)
;       pt14(polar PT14 (* -0.5 PI) 表格_高度)
      pti_x (rtos (car PTI) 2 坐标精度)
      pti_y (rtos (cadr PTI) 2 坐标精度)
      pti_d (rtos (nth j dlst) 2 坐标精度)
      j (1+ j))
(princ (strcat "\nD=" pti_d "X=" pti_y "Y=" pti_x))
(command "TEXT" "MC" "non" PT10 表中字高 0.0 (strcat "J" (itoa i)))
(command "TEXT" "MC" "non" PT11 表中字高 0.0 pti_d)
(command "TEXT" "MC" "non" PT12 表中字高 0.0 pti_x)
(command "TEXT" "MC" "non" PT13 表中字高 0.0 pti_y)
(setq i (1+ i))
)
(setq PT701 (polar PT701 (* -0.5 PI) (* 表格_高度 I)))
(command "color" 外框颜色 "rectang" "W" 0.2 "non" PT0 "non" PT701)
;;编号信息
;(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" "MC" "non" PT9 表中字高 0.0 xxx)
(princ (strcat "\n操作已完成，共收集到" (itoa (1- i)) "个坐标点。"))
))
;;退出处理
(command "undo" "e")
(if (= i 1) (command "undo" 1))
(princ)
)

gzxl 发表于 2013-1-25 20:11:53

ZZXXQQ版主伟大

香田里浪人 发表于 2013-1-25 21:11:51

ZZXXQQ版主确实不简单

zzc83 发表于 2013-1-25 21:39:22

佩服Z版主，高尚啊

知行ooo李肖坪 发表于 2016-1-12 08:26:12

谢谢，同步学习中

zst1978 发表于 2020-2-22 00:19:11

谢谢Z版主大大

页: [1]

明经CAD社区's Archiver

ZZXXQQ版主请进