[编程交流] 选择并移动多行文字（&T）

(defun c:ctxt (/ s i e f o x y l lst)
;; Tharwat 18. mar. 2014 ;;
(princ "\n Select texts to export to txt file :")
(if (setq s (ssget '((0 . "TEXT") (1 . "#*"))))
(progn (setq o (open (setq f (strcat (getvar 'DWGPREFIX) (vl-filename-base (getvar 'DWGNAME)) ".txt")) "w"))
(write-line (strcat "DESCRIPTION" "\t" "QTY") o)
(repeat (setq i (sslength s))
(setq e (entget (ssname s (setq i (1- i))))
x (cdr (assoc 1 e))
b ""
)
(while (wcmatch (setq a (substr x 1 1)) "1,2,3,4,5,6,7,8,9,0")
(setq b (strcat b a)
x (substr x 2)
)
)
(if (setq y (assoc (setq x (substr x 2)) l))
(setq l (subst (cons x (+ (atof b) (cdr y))) y l))
(setq l (cons (cons x (atof b)) l))
)
)
(foreach x l (write-line (strcat (car x) "\t" (rtos (cdr x) 2 1)) o))
(close o)
(startapp "notepad.exe" f)
)
)
(princ)
)

(defun c:ccsv (/ s i e f o x y l lst)
 ;; Tharwat 18. Mar. 2015 ;;
 (princ "\n Select Single line texts to export to Excel file :")
 (if (setq s (ssget '((0 . "TEXT") (1 . "#*"))))
   (progn
     (setq o (open (setq f (strcat (getvar 'DWGPREFIX)
                                   (vl-filename-base (getvar 'DWGNAME))
                                   ".csv"
                           )
                   )
                   "w"
             )
     )
     (write-line (strcat "DESCRIPTION" ";" "QTY") o)
     (repeat (setq i (sslength s))
       (setq e (entget (ssname s (setq i (1- i))))
             x (cdr (assoc 1 e))
             b ""
       )
       (while (wcmatch (setq a (substr x 1 1)) "[0-9]")
         (setq b (strcat b a)
               x (substr x 2)
         )
       )
       (if (setq y (assoc (setq x (substr x 2)) l))
         (setq l (subst (cons x (+ (atof b) (cdr y))) y l))
         (setq l (cons (cons x (atof b)) l))
       )
     )
     (foreach x l
       (write-line (strcat (car x) ";" (rtos (cdr x) 2 1)) o)
     )
     (close o)
   )
 )
 (princ)
)

(defun c:mlen (/ m ss clist temp xls sort combine mlen4_1)
 (defun sort (lst predicate)
   (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
 )
 (defun combine (inlist is-greater is-equal / sorted current result)
   (setq sorted (sort inlist is-greater))
   (setq current (list (car sorted)))
   (foreach item (cdr sorted)
     (if (apply is-equal (list item (car current)))
 (setq current (cons item current))
 (progn
   (setq result (cons current result))
   (setq current (list item))
 )
     )
   )
   (cons current result)
 )
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
 TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
 Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
 (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
 (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
   (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
         *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
              *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
             *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
         *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
              *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                 (vl-filename-base(getvar "DWGNAME"))
                 (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
  col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_?? ???????????? ????????? ?????????
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_??????????? ??????? ? ????? ?????
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_??????????? ???????
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))  
 (defun mlen4_1 (lst / sum_len)
   (setq sum_len 0)
   (foreach item (mapcar 'car lst)
     (setq
 sum_len  (+ sum_len
      (if (vlax-property-available-p item 'length)
        (vla-get-length item)
        (cond
          ((=
       (strcase (vla-get-objectname item) t)
       "acdbarc"
     ) ;_  =
     (vla-get-arclength item)
          )
          ((=
       (strcase (vla-get-objectname item) t)
       "acbcircle"
     ) ;_  =
     (* pi 2.0 (vla-get-radius item))
          )
          (t 0.0)
        ) ;_  cond
      ) ;_  if
   ) ;_  +
     )
   )
   (if  (not (zerop sum_len))
     (princ
 (strcat "\n\t" (cdar lst) " = " (rtos (* sum_len m) 2 4))
     )
   )
   (list (cdar lst)(rtos (* sum_len m) 2 4))
 )
 (vl-load-com)
 (if (null *M*)(setq *M* 1))
 (initget 6)
 (and
   (princ "\nEnter scale factor <")
   (princ *M*)(princ ">: ")
   (or (setq m (getreal))
  (setq m *M*)
  )
   (setq *M* m)
   (setq ss (ssget "_:L"))
   (setq ss (mapcar
        (function vlax-ename->vla-object)
        (vl-remove-if
    (function listp)
    (mapcar
      (function cadr)
      (ssnamex ss)
    ) ;_  mapcar
        ) ;_ vl-remove-if
      )
   )
   (mapcar '(lambda (x)
        (setq temp (cons (cons x (vla-get-Layer x)) temp))
      )
     ss
   )
   (setq clist  (combine temp
      '(lambda (a b)
         (> (cdr a) (cdr b))
       )
      '(lambda (a b)
         (eq (cdr a) (cdr b))
       )
   )
   )
   (princ
     "\n\n  The total length of all line primitives by layers:"
   )
   (setq temp (mapcar 'mlen4_1 clist))
   (xls temp '("Layer" "Length") nil "mlen41")
 )
 (princ)
) ;_  defun