Gu_xl 老大编滴哪位老大能改改进来瞧下啊~谢谢

flytoday · 发表于 2011-12-14 14:13:51

本帖最后由 flytoday 于 2011-12-14 14:49 编辑

Gu_xl 老大这段代码能不能修改成。。
那个A B C线是由CAD画好了，
然后您这个程序由命令可以直接附属ABC线属性呢。
然后当然也能显示板厚板编号属性啊。
功能就是这个变了。。。。
http://bbs.mjtd.com/thread-91136-1-1.html原贴

Gu_xl · 发表于 2011-12-14 15:16:21

本帖最后由 Gu_xl 于 2011-12-14 18:04 编辑

;;;构造匿名块
(defun MakeUnNameBlock (ss pt h a b c bh thickness / count entlist ent blk)
(setq pt (trans pt 1 0))
(entmake (list '(0 . "BLOCK")
'(2 . "*U")
'(70 . 3)
(cons 10 pt)
)
)
(setq count 0)
(repeat (sslength ss)
(setq entlist (entget (setq ent (ssname ss count))))
(setq count (1+ count))
(entmake entlist)
)
(setq count 0)
(repeat (sslength ss)
(setq ent (ssname ss count))
(setq count (1+ count))
(entdel ent)
)
(setq blk (entmake '((0 . "ENDBLK"))))
(regapp "flytoday")
(if blk
(progn
(entmake (list (cons 0 "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1) ;_ 属性跟随标志,1跟随，0不跟随
(cons 2 blk)
(cons 10 pt)
(cons 41 1.0)
(cons 42 1.0)
(cons 43 1.0)
'(-3 ("flytoday" (1000 . "flytoday")))
)
)
;;;插入板编号属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 h)
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 bh)
(cons 7 "Standard")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "板编号")
(cons 70 0)
(cons 74 2)
)
)
;;;插入厚度属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (polar pt (* -0.5 pi) (* 1.5 h)))
(cons 40 h)
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 thickness)
(cons 7 "standard")
(cons 72 0)
(cons 11 (polar pt (* -0.5 pi) (* 1.5 h)))
'(100 . "AcDbAttribute")
(cons 2 "厚度")
(cons 70 0)
(cons 74 2)
)
)
;;;插入a线长度属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (polar pt (* -0.5 pi) (* 3 h)))
(cons 40 h)
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 a)
(cons 7 "standard")
(cons 72 0)
(cons 11 (polar pt (* -0.5 pi) (* 3 h)))
'(100 . "AcDbAttribute")
(cons 2 "a线长度")
(cons 70 1)
(cons 74 2)
)
)
;;;插入b线长度属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (polar pt (* -0.5 pi) (* 4.5 h)))
(cons 40 h)
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 b)
(cons 7 "standard")
(cons 72 0)
(cons 11 (polar pt (* -0.5 pi) (* 4.5 h)))
'(100 . "AcDbAttribute")
(cons 2 "b线长度")
(cons 70 1)
(cons 74 2)
)
)
(if c
;;;插入c线长度属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (polar pt (* -0.5 pi) (* 6 h)))
(cons 40 h)
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 c)
(cons 7 "standard")
(cons 72 0)
(cons 11 (polar pt (* -0.5 pi) (* 6 h)))
'(100 . "AcDbAttribute")
(cons 2 "c线长度")
(cons 70 1)
(cons 74 2)
)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
)
)
blk
)
;;;构造线
(defun makeline (p1 p2)
(entmake (list (cons 0 "line")
(cons 10 (trans p1 1 0))
(cons 11 (trans p2 1 0))
)
)
)
;;;MakeText 生成文字函数,参数：标注点文字字高宽比旋转角倾角
(defun MakeText (xy Txt ZG KB XZ Qj / xyL TxtL ZGL KBL XZL QJL)
(setq xy (trans xy 1 0));;;坐标换算为世界坐标
(setq xyL (cons 10 xy)
TxtL (cons 1 Txt)
ZGL (cons 40 ZG)
KBL (cons 41 KB)
XZL (cons 50 XZ)
QJL (cons 51 QJ)
)
(setq TextL (list '(0 . "TEXT")
'(67 . 0)
'(100
.
"AcDbText"
)
xyL
ZGL
TxtL
XZL
KBL
QJL
'(7 . "standard")
)
)
(entmake TextL)
)
;;;计算两点的中点
(defun MidPoint (p1 p2)
(if (and (> (length p1) 2)(> (length p2) 2))
(list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2))) (* 0.5 (+ (caddr p1) (caddr p2))))
(list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2))))
)
)
;;;(Selectif 条件函数选择动作提示字串) 条件选择
;;;(Selectif (lambda (x) (= "TEXT" (gxl-dxf x 0))) entsel "\n选择 TEXT: ")
(defun Selectif ( foo fun str / e )
(while
(progn (setvar 'ERRNO 0) (setq e (car (fun str)))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\n** 未选中实体, 重新选取 **")
)
( (eq 'ENAME (type e))
(if (and foo (not (foo e)))
(princ "\n** 选择实体无效 **")
)
)
)
)
)
e
)
;;;划线程序
(defun c:tt (/ OLDERR OSMODE CMDECHO ORTHOMODE
SS A B C P1 P2 P3
P4 P0 KD FLAG *error* en enl
)
(defun *error* (msg)
(setq *error* olderr)
(Setvar "osmode" osmode)
(Setvar "cmdecho" cmdecho)
(Setvar "orthomode" orthomode)
(princ msg)
)
(setq olderr *error*)
(setq osmode (getvar "osmode"))
(Setvar "osmode" 687)
(setq cmdecho (getvar "cmdecho"))
(Setvar "cmdecho" 0)
(setq orthomode (getvar "orthomode"))
(Setvar "orthomode" 1)
(or txtHeight
(setq txtHeight (getreal "\n输入字高<400>:"))
)
(if (null txtHeight)
(setq txtHeight 400)
)
(while (not flag)
(setq ss (ssadd)
a nil
b nil
c nil
)
(setq en (Selectif (lambda (x) (= "LINE" (cdr (assoc 0 (setq enl (entget x)))))) entsel "\n 选择a线: "))
(redraw en 3)
(ssadd en ss)
(setq p1 (trans (cdr (assoc 10 enl)) 0 1)
p2 (trans (cdr (assoc 11 enl)) 0 1)
a (rtos (distance p1 p2) 2 3)
)
(MakeText (midpoint p1 (MidPoint p1 p2)) "a" txtHeight 0.8 0 0)
(ssadd (entlast) ss)
;|
(princ "\n绘a线:")
(initget 7)
(setq p1 (getpoint "\n直线第一点:"))
(initget 7)
(setq p2 (getpoint p1 "\n直线第二点:"))
(makeline p1 p2)
(setq a (rtos (distance p1 p2) 2 3))
(ssadd (entlast) ss)
(MakeText (midpoint p1 (MidPoint p1 p2)) "a" txtHeight 0.8 0 0)
(ssadd (entlast) ss)
|;
(setq en (Selectif (lambda (x) (= "LINE" (cdr (assoc 0 (setq enl (entget x)))))) entsel "\n 选择b线: "))
(redraw en 3)
(ssadd en ss)
(setq p3 (trans (cdr (assoc 10 enl)) 0 1)
p4 (trans (cdr (assoc 11 enl)) 0 1)
b (rtos (distance p3 p4) 2 3)
)
(MakeText (polar (midpoint p3 (MidPoint p3 p4)) 0 (* 0.2 txtHeight)) "b" txtHeight 0.8 0 0)
(ssadd (entlast) ss)
;|
(princ "\n绘b线:")
(initget 7)
(setq p3 (getpoint "\n直线第一点:"))
(initget 7)
(setq p4 (getpoint p3 "\n直线第二点:"))
(makeline p3 p4)
(setq b (rtos (distance p3 p4) 2 3))
(ssadd (entlast) ss)
(MakeText (midpoint p3 (MidPoint p3 p4)) "b" txtHeight 0.8 0 0)
(ssadd (entlast) ss)
|;
;(setq p0 (inters p1 p2 p3 p4 nil))
(setq p0 (midpoint
(apply 'mapcar (cons 'min (list p1 p2 p3 p4)))
(apply 'mapcar (cons 'max (list p1 p2 p3 p4)))
)
)
(progn
(setq flag nil)
(while (and (not Flag) (setq en (car(entsel "\n 选c线: "))))
(setq Flag (= "LINE" (cdr (assoc 0 (setq enl (entget en))))))
)
(if en
(progn
(redraw en 3)
(ssadd en ss)
(setq p1 (trans (cdr (assoc 10 enl)) 0 1)
p2 (trans (cdr (assoc 11 enl)) 0 1)
c (rtos (distance p1 p2) 2 3)
)
(MakeText (midpoint p1 (MidPoint p1 p2)) "c" txtHeight 0.8 0 0)
(ssadd (entlast) ss)
)
)
;|
(princ "\n绘c线:")
(if (and
(setq p1 (getpoint "\n直线第一点:"))
(setq p2 (getpoint p1 "\n直线第二点:"))
)
(progn
(makeline p1 p2)
(ssadd (entlast) ss)
(setq c (rtos (distance p1 p2) 2 3))
(MakeText (midpoint p1 (MidPoint p1 p2)) "c" txtHeight 0.8 0 0)
(ssadd (entlast) ss)
)
)
|;
(setq bh (getstring "\n板编号:"))
(setq thickness (getreal"\n厚度:"))
(if (null thickness) (setq thickness "") (setq thickness (rtos thickness 2 0)))
(MakeUnNameBlock ss p0 txtHeight a b c bh thickness)
(initget 7 "Yes No ")
(setq Kd (getkword "\n[继续Yes/No]<Yes>"))
(setq Flag (= kd "No"))
)
)
(setq *error* olderr)
(Setvar "osmode" osmode)
(Setvar "cmdecho" cmdecho)
(Setvar "orthomode" orthomode)
(princ)
)
;;;双击图块，通过属性输入板编号和厚度值
;;;导出数据(c:tt1)
(defun c:tt1 (/ SS F N EN LL ENL BBH THICKNESS A B C filename data)
(setq ss (ssget (list '(0 . "insert") '(-3 ("flytoday")))))
(if ss
(progn
(setq filename (getfiled "保存文件名" "data" "csv" 1))
(if filename
(progn
(if (findfile filename)
(setq f (open filename "a")) ;_ 文件已存在，自动追加
(progn
(setq f (open filename "w")) ;_ 文件不存在，新建文件
(write-line ",a,b,c,板厚" f)
)
)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq ll nil)
(while
(and (setq en (entnext en))
(= "ATTRIB"
(cdr (assoc 0 (setq enl (entget en)))))
)
(setq ll (cons (cdr (assoc 1 enl)) ll))
)
(if ll
(progn
(setq data (cons (reverse ll) data))
)
)
)
(setq data
(vl-sort data
'(lambda (a b)
(< (atof (cadr a)) (atof (cadr b))))))
(foreach ll data
(setq bbh (car ll)
thickness (cadr ll)
a (caddr ll)
b (cadddr ll)
c (car (cddddr ll))
)
(WRITE-LINE
(strcat bbh
","
a
","
b
","
(if c
c
""
)
","
thickness
)
f
)
)
(close f)
;(startapp "notepad.exe" filename)
)
)
)
)
(princ)
)

;;;构造匿名块 
(defun MakeUnNameBlock (ss pt h a b c bh thickness / count entlist ent blk) 
  (setq pt (trans pt 1 0)) 
  (entmake (list '(0 . "BLOCK") 
   '(2 . "*U") 
   '(70 . 3) 
   (cons 10 pt) 
    ) 
  ) 
  (setq count 0) 
  (repeat (sslength ss) 
    (setq entlist (entget (setq ent (ssname ss count)))) 
    (setq count (1+ count)) 
    (entmake entlist) 
  ) 
  (setq count 0) 
  (repeat (sslength ss) 
    (setq ent (ssname ss count)) 
    (setq count (1+ count)) 
    (entdel ent) 
  ) 
  (setq blk (entmake '((0 . "ENDBLK")))) 
  (regapp "flytoday") 
  (if blk 
    (progn 
      (entmake (list (cons 0 "INSERT") 
       '(100 . "AcDbEntity") 
       '(100 . "AcDbBlockReference") 
       '(66 . 1) ;_ 属性跟随标志,1跟随，0不跟随 
       (cons 2 blk) 
       (cons 10 pt) 
       (cons 41 1.0) 
       (cons 42 1.0) 
       (cons 43 1.0) 
       '(-3 ("flytoday" (1000 . "flytoday"))) 
        ) 
      ) 
;;;插入板编号属性 
      (entmake (list 
   '(0 . "ATTRIB") 
   '(100 . "AcDbEntity") 
   '(100 . "AcDbText") 
   (cons 10 pt) 
   (cons 40 h) 
   (cons 50 0) 
   (cons 41 0.8) 
   (cons 51 0) 
   (cons 1 bh) 
   (cons 7 "Standard") 
   (cons 72 0) 
   (cons 11 pt) 
   '(100 . "AcDbAttribute") 
   (cons 2 "板编号") 
   (cons 70 0) 
   (cons 74 2) 
        ) 
      ) 
;;;插入厚度属性 
      (entmake (list 
   '(0 . "ATTRIB") 
   '(100 . "AcDbEntity") 
   '(100 . "AcDbText") 
   (cons 10 (polar pt (* -0.5 pi) (* 1.5 h))) 
   (cons 40 h) 
   (cons 50 0) 
   (cons 41 0.8) 
   (cons 51 0) 
   (cons 1 thickness) 
   (cons 7 "standard") 
   (cons 72 0) 
   (cons 11 (polar pt (* -0.5 pi) (* 1.5 h))) 
   '(100 . "AcDbAttribute") 
   (cons 2 "厚度") 
   (cons 70 0) 
   (cons 74 2) 
        ) 
      ) 
;;;插入a线长度属性 
      (entmake (list 
   '(0 . "ATTRIB") 
   '(100 . "AcDbEntity") 
   '(100 . "AcDbText") 
   (cons 10 (polar pt (* -0.5 pi) (* 3 h))) 
   (cons 40 h) 
   (cons 50 0) 
   (cons 41 0.8) 
   (cons 51 0) 
   (cons 1 a) 
   (cons 7 "standard") 
   (cons 72 0) 
   (cons 11 (polar pt (* -0.5 pi) (* 3 h))) 
   '(100 . "AcDbAttribute") 
   (cons 2 "a线长度") 
   (cons 70 1) 
   (cons 74 2) 
        ) 
      ) 
;;;插入b线长度属性 
      (entmake (list 
   '(0 . "ATTRIB") 
   '(100 . "AcDbEntity") 
   '(100 . "AcDbText") 
   (cons 10 (polar pt (* -0.5 pi) (* 4.5 h))) 
   (cons 40 h) 
   (cons 50 0) 
   (cons 41 0.8) 
   (cons 51 0) 
   (cons 1 b) 
   (cons 7 "standard") 
   (cons 72 0) 
   (cons 11 (polar pt (* -0.5 pi) (* 4.5 h))) 
   '(100 . "AcDbAttribute") 
   (cons 2 "b线长度") 
   (cons 70 1) 
   (cons 74 2) 
        ) 
      ) 
      (if c 
;;;插入c线长度属性 
 (entmake (list 
     '(0 . "ATTRIB") 
     '(100 . "AcDbEntity") 
     '(100 . "AcDbText") 
     (cons 10 (polar pt (* -0.5 pi) (* 6 h))) 
     (cons 40 h) 
     (cons 50 0) 
     (cons 41 0.8) 
     (cons 51 0) 
     (cons 1 c) 
     (cons 7 "standard") 
     (cons 72 0) 
     (cons 11 (polar pt (* -0.5 pi) (* 6 h))) 
     '(100 . "AcDbAttribute") 
     (cons 2 "c线长度") 
     (cons 70 1) 
     (cons 74 2) 
   ) 
 ) 
      ) 
;;;结束标志 
      (entmake '((0 . "SEQEND"))) 
    ) 
  ) 
  blk 
) 
;;;构造线 
(defun makeline (p1 p2) 
  (entmake (list (cons 0 "line") 
   (cons 10 (trans p1 1 0)) 
   (cons 11 (trans p2 1 0)) 
    ) 
  ) 
) 
;;;MakeText 生成文字函数,参数： 标注点 文字 字高 宽比 旋转角 倾角 
 (defun MakeText (xy Txt ZG KB XZ Qj / xyL TxtL ZGL KBL XZL QJL) 
   (setq xy (trans xy 1 0));;;坐标换算为世界坐标 
      (setq xyL  (cons 10 xy) 
     TxtL (cons 1 Txt) 
     ZGL  (cons 40 ZG) 
     KBL  (cons 41 KB) 
     XZL  (cons 50 XZ) 
     QJL  (cons 51 QJ) 
      ) 
      (setq TextL (list '(0 . "TEXT") 
   '(67 . 0) 
   '(100 
     . 
     "AcDbText" 
    ) 
   xyL 
   ZGL 
   TxtL 
   XZL 
   KBL 
   QJL 
   '(7 . "standard") 
    ) 
      ) 
      (entmake TextL) 
    ) 
;;;计算两点的中点 
(defun MidPoint (p1 p2) 
  (if (and (> (length p1) 2)(> (length p2) 2)) 
      (list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2))) (* 0.5 (+ (caddr p1) (caddr p2)))) 
      (list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2)))) 
  )   
  ) 
;;;(Selectif 条件函数 选择动作 提示字串) 条件选择 
;;;(Selectif (lambda (x) (= "TEXT" (gxl-dxf x 0))) entsel "\n选择 TEXT: ") 
(defun Selectif ( foo fun str / e ) 
  (while 
    (progn (setvar 'ERRNO 0) (setq e (car (fun str)))       
      (cond 
        ( (= 7 (getvar 'ERRNO)) 
          (princ "\n** 未选中实体, 重新选取 **") 
        ) 
        ( (eq 'ENAME (type e)) 
          (if (and foo (not (foo e))) 
            (princ "\n** 选择实体无效 **") 
          ) 
        ) 
      ) 
    ) 
  ) 
  e 
) 
;;;划线程序 
(defun c:tt (/      OLDERR  OSMODE  CMDECHO ORTHOMODE       
      SS      A      B      C      P1      P2      P3 
      P4      P0      KD      FLAG *error* en enl 
     ) 
  (defun *error* (msg) 
    (setq *error* olderr) 
    (Setvar "osmode" osmode) 
    (Setvar "cmdecho" cmdecho) 
    (Setvar "orthomode" orthomode) 
    (princ msg) 
  ) 
  (setq olderr *error*) 
  (setq osmode (getvar "osmode")) 
  (Setvar "osmode" 687) 
  (setq cmdecho (getvar "cmdecho")) 
  (Setvar "cmdecho" 0) 
  (setq orthomode (getvar "orthomode")) 
  (Setvar "orthomode" 1) 
  (or txtHeight 
      (setq txtHeight (getreal "\n输入字高<400>:")) 
  ) 
  (if (null txtHeight) 
    (setq txtHeight 400) 
  ) 
  (while (not flag) 
    (setq ss (ssadd) 
   a  nil 
   b  nil 
   c  nil 
    ) 
    (setq en (Selectif (lambda (x) (= "LINE" (cdr (assoc 0 (setq enl (entget x)))))) entsel "\n 选择a线: ")) 
    (redraw en 3) 
    (ssadd en ss) 
    (setq p1 (trans (cdr (assoc 10 enl)) 0 1) 
   p2 (trans (cdr (assoc 11 enl)) 0 1) 
   a (rtos (distance p1 p2) 2 3) 
   ) 
    (MakeText (midpoint p1 (MidPoint p1 p2)) "a" txtHeight 0.8 0 0) 
    (ssadd (entlast) ss) 
    ;| 
    (princ "\n绘a线:") 
    (initget 7) 
    (setq p1 (getpoint "\n直线第一点:")) 
    (initget 7) 
    (setq p2 (getpoint p1 "\n直线第二点:")) 
    (makeline p1 p2) 
    (setq a (rtos (distance p1 p2) 2 3)) 
    (ssadd (entlast) ss) 
    (MakeText (midpoint p1 (MidPoint p1 p2)) "a" txtHeight 0.8 0 0) 
    (ssadd (entlast) ss) 
    |; 
        (setq en (Selectif (lambda (x) (= "LINE" (cdr (assoc 0 (setq enl (entget x)))))) entsel "\n 选择b线: ")) 
    (redraw en 3) 
    (ssadd en ss) 
    (setq p3 (trans (cdr (assoc 10 enl)) 0 1) 
   p4 (trans (cdr (assoc 11 enl)) 0 1) 
   b (rtos (distance p3 p4) 2 3) 
   ) 
    (MakeText (polar (midpoint p3 (MidPoint p3 p4)) 0 (* 0.2 txtHeight)) "b" txtHeight 0.8 0 0) 
    (ssadd (entlast) ss) 
  ;| 
    (princ "\n绘b线:") 
    (initget 7) 
    (setq p3 (getpoint "\n直线第一点:")) 
    (initget 7) 
    (setq p4 (getpoint p3 "\n直线第二点:")) 
    (makeline p3 p4) 
    (setq b (rtos (distance p3 p4) 2 3)) 
    (ssadd (entlast) ss) 
    (MakeText (midpoint p3 (MidPoint p3 p4)) "b" txtHeight 0.8 0 0) 
    (ssadd (entlast) ss) 
    |; 
    ;(setq p0 (inters p1 p2 p3 p4 nil)) 
    (setq p0 (midpoint 
        (apply 'mapcar (cons 'min (list p1 p2 p3 p4))) 
       (apply 'mapcar (cons 'max (list p1 p2 p3 p4))) 
        ) 
   ) 
    (progn 
      (setq flag nil) 
      (while (and (not Flag) (setq en (car(entsel "\n 选c线: ")))) 
 (setq Flag (= "LINE" (cdr (assoc 0 (setq enl (entget en)))))) 
 ) 
      (if en 
 (progn 
   (redraw en 3) 
    (ssadd en ss) 
    (setq p1 (trans (cdr (assoc 10 enl)) 0 1) 
   p2 (trans (cdr (assoc 11 enl)) 0 1) 
   c (rtos (distance p1 p2) 2 3) 
   ) 
    (MakeText (midpoint p1 (MidPoint p1 p2)) "c" txtHeight 0.8 0 0) 
    (ssadd (entlast) ss) 
    
   ) 
 ) 
      ;| 
 (princ "\n绘c线:") 
 (if (and 
       (setq p1 (getpoint "\n直线第一点:")) 
       (setq p2 (getpoint p1 "\n直线第二点:")) 
     ) 
   (progn 
     (makeline p1 p2) 
     (ssadd (entlast) ss) 
     (setq c (rtos (distance p1 p2) 2 3)) 
    (MakeText (midpoint p1 (MidPoint p1 p2)) "c" txtHeight 0.8 0 0) 
    (ssadd (entlast) ss) 
   ) 
 ) 
 |; 
      (setq bh (getstring "\n板编号:")) 
      (setq thickness (getreal"\n厚度:")) 
      (if (null thickness) (setq thickness "") (setq thickness (rtos thickness 2 0))) 
 (MakeUnNameBlock ss p0 txtHeight a b c bh thickness) 
 (initget 7 "Yes No  ") 
 (setq Kd (getkword "\n[继续Yes/No]<Yes>")) 
 (setq Flag (= kd "No")) 
      ) 
  ) 
  (setq *error* olderr) 
  (Setvar "osmode" osmode) 
  (Setvar "cmdecho" cmdecho) 
  (Setvar "orthomode" orthomode) 
  (princ) 
) 
;;;双击图块，通过属性输入板编号和厚度值 
;;;导出数据(c:tt1) 
(defun c:tt1  (/ SS F N EN LL ENL BBH THICKNESS A B C filename data) 
  (setq ss (ssget (list '(0 . "insert") '(-3 ("flytoday"))))) 
  (if ss 
    (progn 
      (setq filename (getfiled "保存文件名" "data" "csv" 1)) 
      (if filename 
 (progn 
   (if (findfile filename) 
     (setq f (open filename "a")) ;_ 文件已存在，自动追加 
     (progn 
       (setq f (open filename "w")) ;_ 文件不存在，新建文件 
       (write-line ",a,b,c,板厚" f) 
       ) 
     ) 
   (repeat (setq n (sslength ss)) 
     (setq en (ssname ss (setq n (1- n)))) 
     (setq ll nil) 
     (while 
       (and (setq en (entnext en)) 
     (= "ATTRIB" 
        (cdr (assoc 0 (setq enl (entget en))))) 
     ) 
        (setq ll (cons (cdr (assoc 1 enl)) ll)) 
        ) 
     (if ll 
       (progn 
  (setq data (cons (reverse ll) data)) 
  ) 
       ) 
     ) 
   (setq data 
   (vl-sort data 
     '(lambda (a b) 
        (< (atof (cadr a)) (atof (cadr b)))))) 
   (foreach ll  data 
     (setq bbh     (car ll) 
    thickness (cadr ll) 
    a     (caddr ll) 
    b     (cadddr ll) 
    c     (car (cddddr ll)) 
    ) 
     (WRITE-LINE 
       (strcat bbh 
        "," 
        a 
        "," 
        b 
        "," 
        (if c 
   c 
   "" 
   ) 
        "," 
        thickness 
        ) 
       f 
       ) 
     ) 
   (close f) 
 ;(startapp "notepad.exe" filename) 
   ) 
 ) 
      ) 
    ) 
  (princ) 
  )

flytoday · 发表于 2011-12-14 15:31:23

Gu_xl 老大谢谢但是a b c 图中没显示啊。。其它都完美了

flytoday · 发表于 2011-12-14 15:42:39

flytoday · 发表于 2011-12-14 15:43:54

上个您修改的是板编号与板最不显示。。这次这两个显示了。abc不显示了

flytoday · 发表于 2011-12-14 16:03:26

本帖最后由 flytoday 于 2011-12-14 16:10 编辑

还有板厚那个只要精确到mm就好哈
;;;插入a线长度属性 (cons 70 1)改成0会显示a 线的长度值，这功能保留（以后我有用哈）。。

要求显示上图那个样子的

flytoday · 发表于 2011-12-14 16:41:10

偶太笨了没表达清楚吧跟字高没关系，，。其它都那么大字了，就是线上要写上AB字样而已

xiaxiang · 发表于 2011-12-14 16:44:23

问题似乎已经找到。。。
gu_xl版主的程序

(defun MakeText (xy Txt ZG KB XZ Qj / xyL TxtL ZGL KBL XZL QJL)
(setq xy (trans xy 1 0));;;坐标换算为世界坐标
....

屏蔽坐标转换似乎没有问题了

flytoday · 发表于 2011-12-14 17:03:10

xiaxiang Gu_xl 两位老大尽心了搞定了谢谢

flytoday · 发表于 2011-12-14 17:12:26

谢谢不愧明经大佬人好

技术强

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

Gu_xl 老大编滴哪位老大能改改进来瞧下啊~谢谢

相关帖子

点评

本帖子中包含更多资源

本帖子中包含更多资源

点评

评分