؟؟-我需要导出尺寸t
您好，我想帮助做lisp，它将维度以我选择对象的相同顺序导出到excel表。。希望大家都好，祝大家好运 欢迎访问本网站mahramou。
我还没有为它编写代码，但我认为这个链接有你想要的：
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/help-me-a-autolisp-export-dimensions-to-excel/td-p/4662311
gr.Rlx 但我不能用它
它对我不起作用
我还没有真正研究过代码，也没有经常使用维度，所以如果其他人有什么东西在货架上。。。否则，贴一个样本，也许我可以看一看（也就是说，如果妻子还没有发现为我计划的其他肮脏任务，新地板、绘画、新卧室、新厨房……它会停止吗，恐怖……）
gr.Rlx rlx我需要这样
http://imgur.com/kNY5hxb
谢谢你抽出时间 我希望能帮我做到这一点
http://imgur.com/kNY5hxb
thnnx到所有 希望有人能帮我这样做
http://imgur.com/kNY5hxb
我做了很少的测试（几分钟内必须离开），但试试这个：
; 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"))
; ("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")
(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)
只需一次性选择文字和尺寸标注，并为行名称的插入点（路径1、路径3等）和尺寸标注的y坐标（节点）之间的距离（y）提供公差。它们大致应该在同一高度。
是的，我知道排序代码不是很好，但现在必须这样做。
我得走了。
gr.Rlx thnnx rlx，，但lisp更复杂，我无法使用它。。重复尺寸（我可能不知道如何调整公差）
好的，可能是不同的方法，没有自动但手动选择
; 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
; 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
; step 3 : after step 2 program will go back to step 1 (text selection mode) again until
; 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)
Rlx级
7月10日更新代码，检查双维度和维度标题。
页:
[1]
2