[编程交流] ؟؟-我需要导出尺寸t

; Dimensions to CSV - written for CadTutor by RLX on 5 th of july 2017 
(defun c:RlxDimensionsToCSV
      ( / p1 p2 txt-selection dim-selection fuzz hit-list row row-list e dim dim-y dim-tst csv-name)
 (vl-load-com)
 (cond
   ((null (setq p1 (getpoint "\nSelect first corner for markers & dimensions : ")))
    (princ "\nSelection process cancelled"))
   ((null (setq p2 (getcorner p1 "\nOther corner : ")))
    (princ "\nInvalid selection or selection process cancelled"))
   ((null (setq txt-selection (ssget "c" p1 p2 '((0 . "TEXT")))))
    (princ "\nNo text markers were found - ending function"))
   ((null (setq dim-selection (ssget "c" p1 p2 '((0 . "DIMENSION")))))
    (princ "\nNo dimensions were found - ending function"))
   ((null (setq fuzz (getdist "\nEnter or specify tolerance between text marker and dimension insertionpoint : ")))
    (princ "\nYou have to give a distance in order for this routine to sort all dimensions to rows"))
   (t
    ; first sort txt-selection which will function as row name
    (setq txt-selection (sssort txt-selection) dim-selection (sssort dim-selection) row-list '())
    ; Now built list for each (text) marker, for example (("marker1" 176.25) ("marker2" 158.75) ...)
    ; each sublist is text string from marker and its y coordinate
    (setq hit-list (mapcar '(lambda (x / e) (list (cdr (assoc 1 (setq e (entget x)))) (caddr (assoc 10 e)))) txt-selection))
    ;now to put each dimension in the right row
    (foreach dim dim-selection
      (setq dim-y (caddr (assoc 13 (setq dim (entget dim)))) dim-txt (cdr (assoc 1 dim)))
      (if (= dim-txt "")(setq dim-txt (rtos (cdr (assoc 42 dim)) 2 2)))
      (mapcar '(lambda (x)
   (if (equal dim-y (cadr x) fuzz)
     (if (setq row (assoc (car x) row-list))
       (setq row-list (subst (reverse (cons dim-txt (reverse row))) row row-list))
       (setq row-list (cons (append x (list dim-txt)) row-list)))))
       hit-list
      )
    )
   )
 )
 (if (vl-consp row-list) (write_to_csv (reverse row-list))(princ "\nNothing to write"))
 (if (and csv-name (and (findfile csv-name)))(RlxDimensionsToCSV_OpenCSV))
 (princ)
)
;el = elist , xl = x , yl = y , ml = matrix , sl = sorted elist
(defun sssort ( ss / e el i xl yl ml sl)
 (if (and ss (> (sslength ss) 1)(setq i 0))
   (progn
     ;ss -> elist ( ((ip)e1) ((ip)e2) .. )
     (while (setq e (ssname ss i))
(setq el (append el (list (list (getip e) e))) i (1+ i)))
     (setq xl (vl-sort (rdup (mapcar 'caar el)) '<)
    yl (vl-sort (rdup (mapcar 'cadar el)) '>))  
     (foreach y yl (foreach x xl (setq ml (append ml (list (list x y))))))
     (setq sl (vl-remove 'nil (mapcar '(lambda (x) (if (assoc x el)(cadr (assoc x el)))) ml))))))
(defun rdup ( i / o );remove duplicates
 (vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) i))
(defun getip (e);get insertionpoint
 (list (cadr (assoc 10 (entget e)))(caddr (assoc 10 (entget e)))))
;LOG (("marker3" 126.25 "38.75" "92.5" "97.5") ("marker2" 158.75 "32.5" "13.75" "101.25") ("marker1" 176.25 "31.25" "130" "40mm"))
;[0] ("marker3" 126.25 "38.75" "92.5" "97.5")
;[1] ("marker2" 158.75 "32.5" "13.75" "101.25")
;[2] ("marker1" 176.25 "31.25" "130" "40mm")
(defun write_to_csv ( %lst / pref dname csv-fp row )
 (setq pref (getvar "dwgprefix") dname (vl-filename-base (getvar "dwgname")) csv-name (strcat pref dname ".csv"))
 (if (setq csv-fp (open csv-name "w"))
   (progn
     (foreach row %lst
(write-line (strcat (car row) "," (cadddr row)) csv-fp)
(mapcar '(lambda (x)(write-line (strcat "," x) csv-fp)) (cdddr row)))
     (close csv-fp)(gc)
   )
 )
)
(defun RlxDimensionsToCSV_OpenCSV ()
 (princ "\nPress space to open csv report , any other key to exit")
 (if (equal (grread) '(2 32)) (or (shell_open (findfile csv-name))(command "notepad" (findfile csv-name)))))
(defun shell_open ( target / shell result )
 (if (and (setq target (findfile target))
   (setq shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")))
   (progn
     (setq result (vl-catch-all-apply 'vlax-invoke (list shell 'open target)))
     (vlax-release-object shell)(not (vl-catch-all-error-p result)))))
(c:RlxDimensionsToCSV)

; Dimensions to CSV - written for CadTutor by RLX on 7 th of july 2017
; Purpose is to create csv file with format :
; --------------------
; |    A   |    B    |
; --------------------
; |  Dim1  |   100   |
; --------------------
; |        |   110   |
; --------------------
; |  Dim2  |  97.5   |
; --------------------
; |        |  23.9   |
; --------------------
;
; Program will loop until the user presses space, enter, R-mouse or escape [sERmoE]
; step 1 : select (text) description for placement in column A
; step 2 : program will directly switch to dimension selection mode and will do so util [sERmoE]
; step 3 : after step 2 program will go back to step 1 (text selection mode) again until [sERmoE]
; step 4 : data will be processed and saved to same name as dwg but with extension csv
; step 5 : if user presses space the created csv file will be opened with associated program (if any)
; since program uses grread to directly read keyboard and mouse input I've programmed also a few keys for zooming
; + and - , z(oom) and e(xtents) , keys are case insensitive.
; Program directly reads cursor position and when no entity is found under selected point it switches to window
; mode (crossing actually).
; Since opp on CadTutor expressed the wish to be able to select each dimension individually, when program switches
; to window mode , still only one entity will get selected , just so you know you know...
; If dimension has text override , this will be the value saved to csv file
(defun c:RlxDimensionToCSV ( / dim-title dim dim-sel csv-list csv-name)
 (vl-load-com)
 (princ "\nSelect dimension title (text) : ")
 (setq dim-title (RlxSel1 "TEXT"))
 (while dim-title
   (setq dim-title (cdr (assoc 1 (entget dim-title))))
   (if (assoc dim-title csv-list)
     (alert "Dimension title allready in list")
     (progn
(setq dim-sel '())
(princ "\nSelect dimensions : ")
(while (setq dim (RlxSel1 "DIMENSION"))
  (if (not (member dim dim-sel))
    (setq dim-sel (reverse (cons dim (reverse dim-sel))))))
(if (and dim-title dim-sel)
  (setq csv-list (reverse (cons (list dim-title dim-sel) (reverse csv-list)))))
     ); end progn
   ); end if
   (princ "\nSelect next dimension title or enter to write selection to csv file : ")
   (setq dim-title (RlxSel1 "TEXT"))
 ); end while
 
 ; refresh drawing
 (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
 
 ;selection process is complete , now process & save data
 (if (not (vl-consp csv-list))
   (alert "No data to process - ending program")
   (progn
     (setq csv-list (_convert csv-list))
     (if (vl-consp csv-list) (write_to_csv csv-list)(alert "Nothing to write"))
     (if (and csv-name (and (findfile csv-name)))(RlxDimensionsToCSV_OpenCSV))
   )
 )
 (princ)
)
(defun write_to_csv ( %lst / pref dname csv-fp row )
 (setq pref (getvar "dwgprefix") dname (vl-filename-base (getvar "dwgname")) csv-name (strcat pref dname ".csv"))
 (if (setq csv-fp (open csv-name "w"))
   (progn
     (foreach row %lst
(write-line (strcat (car row) "," (cadr row)) csv-fp)
(mapcar '(lambda (x)(write-line (strcat "," x) csv-fp)) (cddr row)))
     (close csv-fp)(gc)
   )
 )
)
(defun RlxDimensionsToCSV_OpenCSV ()
 (princ "\nPress space to open csv report , any other key to exit")
 (if (equal (grread) '(2 32)) (or (shell_open (findfile csv-name))(command "notepad" (findfile csv-name)))))
(defun shell_open ( target / shell result )
 (if (and (setq target (findfile target))
   (setq shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")))
   (progn
     (setq result (vl-catch-all-apply 'vlax-invoke (list shell 'open target)))
     (vlax-release-object shell)(not (vl-catch-all-error-p result)))))
(defun get_type ( %o )
 (cond
   ((= (type %o) 'ENAME)(cdr (assoc 0 (entget %o))))
   ((= (type %o) 'VLA-object)(cdr (assoc 0 (entget (vlax-vla-object->ename  %o)))))
   (t nil)
 )
)
(defun RlxSel1 ( $e-type / done-selecting inp i p2 result e ent)
 (princ (strcat "\nEsc, enter, Rmouse to cancel, zoom with E(extend), Z(oom) or + / -\nSelect " $e-type))
 (setq done-selecting nil)
 (while (not done-selecting)
   (setq inp (vl-catch-all-apply 'grread (list nil 4 2)))
   (if (vl-catch-all-error-p inp)
     (setq done-selecting t result nil)
     (cond
; if point selected
((= (car inp) 3)
 ; if point has object under it
 (if (setq ent (nentselp (cadr inp))) (setq e (car ent) typ (get_type e)))
 (cond
   ; if we have object and object is the right type we have a winner
   ((and e typ (eq $e-type typ))
    (redraw e 3)(setq done-selecting t result e))
   ; maybe its the parent
   ; this happens when type is dimension and you select dimensions text
   ((and (caddr ent) (setq ent (last (last ent)))(eq $e-type (get_type ent)))
    (redraw ent 3)(setq done-selecting t result ent))
   ; sorry object is not the right stuf
   ((and e typ (not (eq $e-type typ)))
    (princ (strcat "\nYou selected the wrong type (" $e-type ")")))
   ; else try crossing selection
   (t
    (if (and (setq i 0 p2 (getcorner (cadr inp) "\tOther corner : "))
      (setq ss (ssget "c" (cadr inp) p2)))
      (while (setq e (ssname ss i))
 (if (= (cdr (assoc 0 (entget e))) $e-type)
   (progn (redraw e 3) (setq result e done-selecting t)))
 (setq i (1+ i))))
   );end t
  ); end cond
       ); end (= (car inp) 3)
; user pressed E of e
((member inp '((2 69)(2 101))) (command "zoom" "e"))
; user clicked R-mouse button, pressed enter or space (done selecting)
((or (equal (car inp) 25)(member inp '((2 13)(2 32))))
 (setq done-selecting t result nil))
; user pressed +
((equal inp '(2 43)) (command "zoom" "2x"))
; user pressed -
((equal inp '(2 45)) (command "zoom" ".5x"))
; user pressed z or Z
((member inp '((2 122)(2 90))) (command "'zoom" ""))
     )
   )
 )
 result
)
(defun _convert ( %lst / item name dim-ent dim-strings lst )
 (foreach item %lst
   (setq name (car item) dim-strings '())
   (foreach dim-ent (cadr item) (setq dim-strings (cons (get_dim_string dim-ent) dim-strings)))
   (setq lst (cons (cons name (reverse dim-strings)) lst))
 )
 (reverse lst)
)
(defun get_dim_string ( %dim / dim dim-txt)
 (setq dim (entget %dim) dim-txt (cdr (assoc 1 dim)))
 (if (= dim-txt "")(setq dim-txt (rtos (cdr (assoc 42 dim)) 2 2)) dim-txt))
(c:RlxDimensionToCSV)