例行Lisp
你好！你们好！我再次请求帮助！！我非常感谢那些花时间和精力帮助别人的人。好吧，这里有一个想做的事。
我想创建一个调用comand的路由，所以我将运行这个例程并调用，比如说“ATTEXP2XL”，运行它完成，然后调用另一个命令，比如说“aenext”，以进入下一个绘图。再重复一遍，直到项目经理看完所有的图纸。
顺便说一句，在运行lisp“attexp2xl”后，您必须选择对象。如何修改它以选择块名而不选择它。
再次感谢您的帮助！！ 使用LISP时，该函数将在两个图形之间切换时终止，因此您可能需要使用一些VBA或脚本来完成所需的操作。 选择块名为“BLOCKNAME”的块
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "BLOCKNAME")
(if (getvar "CTAB")
(cons 410 (getvar "CTAB"))
(cons 67 (- 1 (getvar "TILEMODE")))))))
李，谢谢你的重播！
我可以用它从块的属性值中提取信息吗？以及如何在CAD中使用vba？
再次感谢！ 不，发布的代码将只创建具有该块名称的块的选择集。
你想要实现什么？我可以帮助学习LISP，但我对VBA知之甚少。 我试图做的是使用一个名为“attexp2xl”的Lisp，它将块属性值提取到excel中。当我运行它时，它会要求我选择对象=“具有属性的块”，它会将块中的值提取到excel中，如果有多个块，只要它们具有相同的块名称，就会提取它们。现在，我必须用几幅画来做。打开图形运行lisp并选择块，保存关闭并打开下一个图形。
我正在使用autocad electric 2009和项目管理器，该项目管理器允许我绘制图形，只要图形在项目managar中，a就可以从一个图形浏览到另一个图形。因此，有一个comand“aenext”允许我转到下一个绘图并保存我正在工作的绘图。
我希望这能帮助你理解我在做什么。
再次感谢你的帮助！！
干杯 如果您发布了attexp2xl，我可以修改它，让您自动选择块-但不确定aenext，从未遇到过这种情况。很抱歉 这是Lisp程序，我从这个论坛上得到的。其他人张贴了它，效果很好。但如果你可以根据我的需要修改，那就更好了。
非常感谢。
密码
attexp2xl。lsp 试一试。。。但未经测试。。。
(vl-load-com)
(defun mip-conv-to-str (dat)
(if dat
(vl-princ-to-string dat)
""))
(defun get-all-atts(obj)
(if (and obj
(eq :vlax-true (vla-get-HasAttributes obj))
(vlax-property-available-p obj 'Hasattributes))
(vl-catch-all-apply
(function (lambda ()
(mapcar (function (lambda (x)
(cons (vla-get-TagString x)
(vla-get-TextString x))))
(append (vlax-invoke obj 'Getattributes)
(vlax-invoke obj 'Getconstantattributes)
)))))))
;|================== XLS ========================================
* Purpose: Export of the list of data punto_datos in Excell
* It is exported to a new leaf of the current book.
If the book is not present, it is created
* Arguments:
punto_datos - The list of lists of data (LIST)
((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
Each list of a kind (Value1 Value2... VlalueN) enters the name in
a separate line in corresponding columns (Value1-A Value2-B and .ò.ä.)
header -The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
If header nil, is accepted ("X" "Y" "Z")
Colhide -The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
Name_list - The name of a new leaf of the active book or nil - is not present
* Return: nil
* Usage
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3""Col4") '("B") "test") |;
(vl-load-com)
(defun xls(punto_datos 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)
(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 punto_datos)
(setq iz_listo (car punto_datos))
(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 punto_datos (cdr punto_datos))
(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 C:ATTEXP2XL(/ blk pat head ss datalist att_list)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1)(if (getvar "CTAB")
(cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
(progn
(foreach item(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq att_list (get-all-atts item))
(if (null head)
(setq head (mapcar 'car att_list)))
(setq datalist (append datalist (list (mapcar 'cdr att_list))))
)
(xls datalist head nil nil)
)
)
(princ)
)
;|=============== Comand AREAS ================================================
Send the Layer, the area, length, color, a hyperlink in corresponding columns Excel.
See also _HYPERLINKOPTIONS |;
(defun c:AREAS (/ selset *error* retLst lst i UrlDes are)
(defun *error* (msg) (princ msg) (princ)) ;_ end of defun
(vl-load-com)
(if (setq selset (ssget '((0 . "*POLYLINE"))))
(progn (setq i 1)
(foreach item(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))
(if (not (zerop (vla-get-Count (vla-get-Hyperlinks item))))
(VL-CATCH-ALL-APPLY
'(lambda () (setq UrlDes (vla-get-URLDescription (vla-item (vla-get-Hyperlinks item) 0)))))
(setq UrlDes ""))
(setq lst (list
(strcat "'" (vla-get-layer item)) ;|Layer"|;
(rtos (setq are (vla-get-area item)) 2 12) ;|Area|;
(rtos (vla-get-Length item) 2 12) ;|Length|;
(vla-get-color item) ;|Color|;
(if (= UrlDes "")
""
(strcat "'" UrlDes)) ;|Hyperlink|;
))
(setq retLst (append retLst (list lst)))) ;_foreach
(xls retlst '("Layer" "Area" "Length" "Color" "Hyperlink") nil "from AREAS")))
(princ))
页:
[1]