用于CenterPoint导出wi的Lisp
大家好，以下是我到目前为止可以使用以下代码（主要来自Tharwat，但我做了一些调整）：
1） 它要求用户输入指定原点（基本上设置UCS）
2） 将XY直径细节导出到excel文件（&D）（使用trans函数将XY转换为当前UCS）
3） 添加0,0原点文本，以便用户知道原点是否正确。
我想要的是：
1） 所有实体（圆弧或圆）应在图纸1、2、3等上编号。。。。
2） 它创建的表格应具有第一列序列号（每个项目1）和第五列实体类型（例如圆弧或圆），以识别对象类型。
有人能帮我吗？
干杯 您需要使用代码标记而不是引号标记。代码发布指南 为什么不显示您希望的输出？做一张桌子，展示它应该是什么样子。以您希望的方式显示图形中编号的一些圆弧和圆。 虽然重新编写lisp很有趣，但我坚持使用您的格式。
(defun c:XYT (/ *error* fl f ss i sn e c d x y DLName)
(SETVAR "TEXTSIZE" 2.5)
(defun *error* (msg)
(and f (close f))
(princ (strcat "\nError: " msg "\n*Cancel*"))
)
(if (and (setq fl (getfiled "Specify the .xls file name :"
(getvar 'DWGPREFIX)
"xls"
1
)
)
(setq f (open fl "w"))
(progn
(setq orgn (getpoint "\n Specify the origin:"))
(command "ucs" "o" orgn)
(princ "\n Select Ellipse, Arcs & Circles")
(setq ss (ssget '((0 . "CIRCLE,ARC"))))
)
)
(progn
(write-line "Serial Number: \t X: \t Y: \t Dia: \t Type:" f)
(setq loop 1)
(repeat (setq i (sslength ss))
(setq e (entget (setq sn (ssname ss (setq i (1- i)))))
c (cdr (assoc 10 e))
)
(setq d (* (cdr (assoc 40 e)) 2.))
(write-line
(strcat (rtos loop)
"\t"
(setq x (rtos (car (trans c 0 1)) 2 3))
"\t"
(setq y (rtos (cadr (trans c 0 1)) 2 3))
"\t"
(setq d (rtos d 2 3))
"\t"
(cdr(assoc 0 e))
)
f
)
(command "mtext" (strcat x "," y) "j" "mc" (strcat x "," y) loop "")
(setq loop (+ 1 loop))
)
(close f)
(command "mtext" "0,0" "j" "tr" "-2,-2" "0,0" "ORIGIN" "")
(command "chprop" "l" "" "c" "4" "")
; (load "tbl3")
; (tbl3)
(princ)
)
(princ)
)
)
在这里，使用AC2008和“ellipse”命令绘制椭圆似乎不起作用。
这是因为原作不能处理椭圆。我本想问他是否想包括椭圆，但他的声明只提到了圆和弧。我想也许他一开始想要省略号，但后来又删除了。 如果需要椭圆。。。
(defun c:XYT (/ *error* fl f ss i sn e c d x y DLName)
(SETVAR "TEXTSIZE" 2.5)
(defun *error* (msg)
(and f (close f))
(princ (strcat "\nError: " msg "\n*Cancel*"))
)
(if (and (setq fl (getfiled "Specify the .xls file name :"
(getvar 'DWGPREFIX)
"xls"
1
)
)
(setq f (open fl "w"))
(progn
(setq orgn (getpoint "\n Specify the origin:"))
(command "ucs" "o" orgn)
(princ "\n Select Ellipse, Arcs & Circles")
(setq ss (ssget '((0 . "CIRCLE,ARC,ELLIPSE"))))
)
)
(progn
(write-line "Serial Number: \t X: \t Y: \t Dia: \t Type:" f)
(setq loop 1)
(repeat (setq i (sslength ss))
(setq e (entget (setq sn (ssname ss (setq i (1- i)))))
c (cdr (assoc 10 e))
)
(setq d (* (cdr (assoc 40 e)) 2.))
(write-line
(strcat (rtos loop)
"\t"
(setq x (rtos (car (trans c 0 1)) 2 3))
"\t"
(setq y (rtos (cadr (trans c 0 1)) 2 3))
"\t"
(setq d (rtos d 2 3))
"\t"
(cdr(assoc 0 e))
)
f
)
(command "mtext" (strcat x "," y) "j" "mc" (strcat x "," y) loop "")
(setq loop (+ 1 loop))
)
(close f)
(command "mtext" "0,0" "j" "tr" "-2,-2" "0,0" "ORIGIN" "")
(command "chprop" "l" "" "c" "4" "")
; (load "tbl3")
; (tbl3)
(princ)
)
(princ)
)
)
很好，谢谢！！ 哇，这正是我所希望的。好东西Commandobill。
与我发布的内容相比，我会花一些时间完全理解你是如何做到这一点的。
说如果没有太多的要求。可以按类型列出项目吗。就像所有的圆都列在第一位，然后是所有的弧，然后是椭圆？
或者可能是，如果可能的话，比如说圆编号为C1，C2。。。弧编号为A1、A2。。。。椭圆E1，E2。。。
只是好奇。。。 像这样的？
(defun c:XYT (/ *error* c f itemlist loop objlet objtype orgn osmode sorteditemlist textsize x y z)
(defun *error* ( msg )
(if osmode (setvar 'OSMODE osmode))
(and f (close f))
(setvar 'textsize textsize)
(setvar 'cmdecho 1)
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq osmode (getvar 'osmode))
(setq textsize (getvar 'textsize))
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(setvar 'textsize 2.5)
(if (and (setq fl (getfiled "Specify the .xls file name :"
(getvar 'DWGPREFIX)
"xls"
1
)
)
(setq f (open fl "w"))
(progn
(setq orgn (getpoint "\n Specify the origin:"))
(command "ucs" "o" orgn)
(princ "\n Select Ellipse, Arcs & Circles")
(setq ss (ssget '((0 . "CIRCLE,ARC,ELLIPSE"))))
)
)
(progn
(write-line "Serial Number: \t X: \t Y: \t Dia: \t Type:" f)
(if (setq itemList (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(progn
(setq sortedItemList (vl-sort itemList '(lambda (x z) (< (cdr (assoc 0 x)) (cdr (assoc 0 z))))))
(mapcar '(lambda (z)
(if (not (eq (cdr(assoc 0 z)) objType))
(setq loop 1))
(write-line
(strcat (setq objLet (substr (setq objType (cdr (assoc 0 z))) 1 1)) (itoa loop)
"\t"
(setq x (rtos (car (trans (setq c (cdr (assoc 10 z))) 0 1)) 2 3))
"\t"
(setq y (rtos (cadr (trans c 0 1)) 2 3))
"\t"
(rtos (* (cdr (assoc 40 z)) 2.) 2 3)
"\t"
(cdr(assoc 0 z))
)
f
)
(command "mtext" (strcat x "," y) "j" "mc" (strcat x "," y) (strcat objLet (itoa loop)) "")
(setq loop (+ 1 loop))
) sortedItemList)))
(close f)
(command "mtext" "0,0" "j" "tr" "-2,-2" "0,0" "ORIGIN" "")
(command "chprop" "l" "" "c" "4" "")
(princ)
)
(princ)
)
(setvar 'osmode osmode)
(setvar 'cmdecho 1)
(setvar 'textsize textsize)
)
页:
[1]
2