圆中的文字怎么输出？

微博评论 · 发表于 2013-3-24 08:27:44

转发微博

来自 NB闪闪的拿拿斯1988 的新浪微博

微博评论 · 发表于 2013-3-24 08:27:44

转发微博

来自 coolgirl奈津生的新浪微博

ZZXXQQ · 发表于 2013-3-24 09:23:56

[post=5]

(defun c:tt ()
(setq fn (if (= (type fn) 'STR) fn ""))
(setq fn (getfiled "输出文件名" fn "txt" 4))
(if (setq ss (ssget '((0 . "CIRCLE") (40 . 5.0)))) (progn
(setq i -1)
(setq fp (open fn "w"))
(repeat (sslength ss)
(setq pc (cdr(assoc 10 (entget(ssname ss (setq i (1+ 1))))))
p1 (mapcar '+ pc (list 5 5))
p2 (mapcar '- pc (list 5 5)))
(if (= (sslength(setq ss1 (ssget "C" p1 p2 '((0 . "TEXT"))))) 2) (progn
(setq ent1 (entget(ssname ss1 0)) ent2 (entget(ssname ss1 1))
pt1 (cdr(assoc 10 ent1)) pt2 (cdr(assoc 10 ent2)))
(if (> (cadr pt1) (cadr pt2))
(princ (strcat(cdr(assoc1 1 ent1)) (cdr(assoc 1 ent2))) fp)
(princ (strcat(cdr(assoc1 1 ent2)) (cdr(assoc 1 ent1))) fp)
)
))
)
(close fp)
))
(princ)
)

[/post

vlisp2012 · 发表于 2013-5-9 15:38:23

Z版好程序，今天才看到！

zbwei120 · 发表于 2013-7-12 00:06:56

Z版好程序,好久出手一回，学习中

香田里浪人 · 发表于 2013-7-28 16:10:31

版主的程序略做改造，也可以输出到word

香田里浪人 · 发表于 2013-7-29 08:43:04

(defun wbdc_defun ()
  (defun wbdc_set (se) ;将文本实体选择集转换为含实体名的表
(setq l1 (sslength se)
   i 0
   set0 nil
)
(repeat l1
   (setq e0    (ssname se i)
      set0 (cons e0 set0)
      i    (1+ i)
   )
)
  )

  (defun wbdc_sorten (se axis) ;实体按x、y排序
(setq ss nil
   sexy (mapcar
   '(lambda (x)
      (axis (trans (cdr (assoc 10 (entget x))) 0 1))
   )
   se
         )
)
(repeat (length se)
   (setq mc    (apply 'max sexy)
      ii    0
      i    -1
      list1 nil
      list0 nil
   )
   (while (= ii 0)
(setq i    (1+ i)
      sei (nth i se)
      xy  (axis (trans (cdr (assoc 10 (entget sei))) 0 1))
)
(if (= mc xy)
   (setq ss (cons sei ss)
ii 1
   )
   (setq list1 (cons (nth i sexy) list1)
list0 (cons sei list0)
   )
)
   )
   (setq sexy (append (reverse list1) (cdr (member mc sexy)))
      se    (append (reverse list0) (cdr (member sei se)))
   )
)
(setq ss (reverse ss))
  )

  (defun wbdc_row () ;将实体分行
(wbdc_sorten set0 cadr)
(setq row  1
   set1 (cons (cons (car ss) row) nil)
)
(mapcar
   '(lambda (x)
   (if (< (+ (cadr (trans (cdr (assoc 10 (entget x))) 0 1))
   (cdr (assoc 40 (entget x)))
)
(cadr (trans (cdr (assoc 10 (entget (caar set1)))) 0 1))
      )
   (setq row (1+ row))
   )
   (setq set1 (cons (cons x row) set1))
   )
   (cdr ss)
)
(setq set1 (reverse set1))
  )

  (defun wbdc_col () ;将实体分列
(setq ss (reverse (wbdc_sorten set0 car)))
(setq col  1
   set2 (cons (cons (car ss) col) nil)
)
(mapcar
   '(lambda (x)
   (setq ym nil)
   (mapcar
   '(lambda (y)
      (if (= (cdr y) col)
(setq tmp (entget (car y))
      ym  (cons
      (+ (car (trans (cdr (assoc 10 tmp)) 0 1))
         (caadr (textbox tmp))
      )
      ym
   )
)
      )
      )
   set2
   )
   (if (> (car (trans (cdr (assoc 10 (entget x))) 0 1))
(apply 'max ym)
      )
   (setq col (1+ col))
   )
   (setq set2 (cons (cons x col) set2))
   )
   (cdr ss)
)
(setq set2 (reverse set2))
  )

  (defun wbdc_main ()
(while (not fn)
   (setq fn (getfiled "文本文件" "CADwrod" "doc" 13))
)
(if (findfile fn)
   (progn
(initget "Add wbdcite")
(setq fs (getkword "\n覆盖W/<附加A>: "))
(if (= fs "wbdcite")
   (setq fs (open fn "w"))
   (setq fs (open fn "a"))
)
   )
   (setq fs (open fn "a"))
)
(initget "Normal Tab")
(setq wmode (getkword "\n制表模式T/<普通文本N>: "))
(if (= wmode nil)
   (setq wmode "Normal")
)
(wbdc_set se1)
(wbdc_row)
(wbdc_col)
(setq ij 0)
(repeat row
   (setq l1 nil
      ij (1+ ij)
   )
   (mapcar
'(lambda (x)
   (if (= (cdr x) ij)
      (setq l1 (cons (car x) l1))
   )
   )
set1
   )
   (setq l1 (reverse (wbdc_sorten l1 car))
      j1 1
   )
   (mapcar
'(lambda (x)
   (setq j2 (cdr (assoc x set2)))
   (if (= wmode "Tab")
      (progn
         (repeat (- j2 j1)
   (princ "\t" fs)
         )
         (princ (cdr (assoc 1 (entget x))) fs)
      )
      (progn
         (repeat (- j2 j1 1)
   (princ " " fs)
         )
         (princ (cdr (assoc 1 (entget x))) fs)
      )
   )
   (setq j1 j2)
   )
l1
   )
   (princ "\n" fs)
)
(close fs)
  )
)

(defun c:wbdc (/       axis col    e0       fn       fs       i       ii
      ij       j1       j2       l1       list0 list1 mc       olderr
      oldsnp  oldzin  row    se       set0 set1 set2 ss
      text_name       tmp    wmode x       y       ym       wbdc_col
      wbdc_main wbdc_m_pt wbdc_row  wbdc_sorten       wbdc_set  na
      )
  (command "color" (getvar "cecolor"))
  (princ "\n选取文本: ")
  (setq se1 (ssget '((0 . "TEXT"))))
  (if se1
(progn
   (wbdc_defun)
   (wbdc_main)
)
(princ "\n空选择集。")
  )
  (princ)
)

(princ "\n**Text文本写入文件，ljs5178@126.com**")
(princ "\n**命令：wbdc")

winds357 · 发表于 2013-8-18 18:38:13

学习一下！

magicheno · 发表于 2023-1-15 14:45:02

香田里浪人发表于 2013-7-29 08:43
(defun wbdc_defun ()
(defun wbdc_set (se) ;将文本实体选择集转换为含实体名的表
(setq l1 ( ...

感谢大佬分享，学习了

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