用于CenterPoint导出wi的Lisp

shailujp · 发表于 2022-7-6 06:13:56

大家好，

以下是我到目前为止可以使用以下代码（主要来自Tharwat，但我做了一些调整）：
1）它要求用户输入指定原点（基本上设置UCS）
2）将XY直径细节导出到excel文件（&D）（使用trans函数将XY转换为当前UCS）
3）添加0,0原点文本，以便用户知道原点是否正确。

我想要的是：
1）所有实体（圆弧或圆）应在图纸1、2、3等上编号。。。。
2）它创建的表格应具有第一列序列号（每个项目1）和第五列实体类型（例如圆弧或圆），以识别对象类型。

有人能帮我吗？

干杯

SLW210 · 发表于 2022-7-6 06:21:56

您需要使用代码标记而不是引号标记。代码发布指南

neophoible · 发表于 2022-7-6 06:22:42

为什么不显示您希望的输出？做一张桌子，展示它应该是什么样子。以您希望的方式显示图形中编号的一些圆弧和圆。

Commandobill · 发表于 2022-7-6 06:26:20

虽然重新编写lisp很有趣，但我坚持使用您的格式。

copy

(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)
   )
 )

stevesfr · 发表于 2022-7-6 06:33:27

在这里，使用AC2008和“ellipse”命令绘制椭圆似乎不起作用。

Commandobill · 发表于 2022-7-6 06:36:36

这是因为原作不能处理椭圆。我本想问他是否想包括椭圆，但他的声明只提到了圆和弧。我想也许他一开始想要省略号，但后来又删除了。

Commandobill · 发表于 2022-7-6 06:41:02

如果需要椭圆。。。

copy

(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)
)
)

stevesfr · 发表于 2022-7-6 06:42:31

很好，谢谢！！

shailujp · 发表于 2022-7-6 06:50:01

哇，这正是我所希望的。好东西Commandobill。

与我发布的内容相比，我会花一些时间完全理解你是如何做到这一点的。

说如果没有太多的要求。可以按类型列出项目吗。就像所有的圆都列在第一位，然后是所有的弧，然后是椭圆？
或者可能是，如果可能的话，比如说圆编号为C1，C2。。。弧编号为A1、A2。。。。椭圆E1，E2。。。

只是好奇。。。

Commandobill · 发表于 2022-7-6 06:53:58

像这样的？

copy

(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)
 )

[编程交流] 用于CenterPoint导出wi的Lisp

发表回复

精选推荐