能否用lisp实现快速将选中的图元另存一个cad文件

司徒妙嘉

如下图, N多零件, 都是平板零件, 我需要把每一个零件图形都按上面的文字另存为一个单独的cad文件. 有什么快速的好的解决方法?
目前手动从总图中一个个复制到另一个空白的文件中,然后按上面的文字为文件名另存. 另存后删除图形, 再到总图中复制下一个, 如此循环. 心累.
有没有什么跟快速的方法?

lisp语言我不懂. 但是我思路是这样的, 用lisp创建一个新的command, 从总图中选中想要的(包含文字). 然后按下这个command, 自动复制, 并识别选中图元中的唯一文字内容, 然后自动新建文件, 粘贴内容, 按识别到的文字进行另存, 并关闭文件. 需要人工操作的就是一个选择内容以及按下那个command. 有点像宏, 但是这个需要一个对选中内容中的文字内容进行一个操作.
不知道以上我的想法能不能实现? 或者里面的有什么更快的方法, 因为这些肯定都是封闭轮廓的图形, 能不能利用这一点,实现批量完成? 毕竟以上思路的cammand还得一个个的操作. 其他更高深的方法尽管提.

司徒妙嘉

Kye 发表于 2017-11-27 19:21
二楼龙龙仔前辈的程序应该是可以的啊，先做个空白的模板文件，复制模板文件为新文件，然后将选择的东西复制 ...

我是看不懂, 好半天才把括号给对起来

2. (defun C:COPY_2_OTHER_DWG (/ DOC LST N NEWDWG SS NAME)
   
3.         (vl-load-com)
   
4.         (if
   
5.                 (and
   
6.                         (setq SS (ssget (list (cons 410 (getvar "ctab")) (cons 0 (strcat "~" "VIEWPORT")))))
   
7.                         (setq NAME (getfiled "Start DWG" (getvar "ACADPREFIX") "dwg" 8))
   
8.                         (setq NAME (findfile NAME))
   
9.                 )
   
10.                 (progn
    
11.                         (setq N -1 DOC (vla-get-activedocument (vlax-get-acad-object))
    
12.                                 NEWDWG (vla-open (vla-get-documents (vlax-get-acad-object)) NAME)
    
13.                         )
    
14.                         (repeat
    
15.                                 (sslength SS)
    
16.                                 (setq LST
    
17.                                         (cons (vlax-ename->vla-object (ssname SS (setq N (1+ N)))) LST)
    
18.                                 )
    
19.                         )
    
20.                         (vla-copyobjects DOC
    
21.                                 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length LST)))) LST)
    
22.                                 (if
    
23.                                         (equal (getvar "ctab") "Model")
    
24.                                         (vla-get-modelspace NEWDWG)
    
25.                                         (vla-get-paperspace NEWDWG)
    
26.                                 )
    
27.                         )
    
28.                         (vla-saveas NEWDWG NAME acnative)
    
29.                         (vla-close NEWDWG)
    
30.                         (vlax-release-object DOC)
    
31.                         (vlax-release-object EWDWG)
    
32.                 )
    
33.         )
    
34.         (princ)
    
35. )

(defun C:COPY_2_OTHER_DWG (/ DOC LST N NEWDWG SS NAME)<br />         (vl-load-com)<br />         (if<br />                 (and <br />                         (setq SS (ssget (list (cons 410 (getvar "ctab")) (cons 0 (strcat "~" "VIEWPORT")))))<br />                         (setq NAME (getfiled "Start DWG" (getvar "ACADPREFIX") "dwg" 8))<br />                         (setq NAME (findfile NAME))<br />                 )<br />                 (progn <br />                         (setq N -1 DOC (vla-get-activedocument (vlax-get-acad-object))<br />                                 NEWDWG (vla-open (vla-get-documents (vlax-get-acad-object)) NAME)<br />                         )<br />                         (repeat<br />                                 (sslength SS)<br />                                 (setq LST<br />                                         (cons (vlax-ename->vla-object (ssname SS (setq N (1+ N)))) LST)<br />                                 )<br />                         )<br />                         (vla-copyobjects DOC<br />                                 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length LST)))) LST)<br />                                 (if<br />                                         (equal (getvar "ctab") "Model")<br />                                         (vla-get-modelspace NEWDWG)<br />                                         (vla-get-paperspace NEWDWG)<br />                                 )<br />                         )<br />                         (vla-saveas NEWDWG NAME acnative)<br />                         (vla-close NEWDWG)<br />                         (vlax-release-object DOC)<br />                         (vlax-release-object EWDWG)<br />                 )<br />         )<br />         (princ)<br /> )

liunian0524

1:高飞鸟大师有一个批量写块;;==============批量写块=================
(defun c:ww (/ *error* cmdecho filename name path i)
  (defun *error* (s)
    (princ s)
    (setvar 'cmdecho cmdecho)
    )
  (setq cmdecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (cond
    ((not (setq filename (getfiled "保存文件名" "" "dwg" 1))))
    (t
     (setq name (VL-FILENAME-BASE filename)
           path (strcat (VL-STRING-RIGHT-TRIM
                          "\\"
                          (VL-FILENAME-DIRECTORY filename)
                          )
                        "\\"
                        )
           i    0
           )
     (princ "\n选择写块物体:")
     (while (setq ss (ssget))
       (command "wblock"
                (strcat path name (itoa (setq i (1+ i))) ".dwg")
                ""
                "0,0,0"
                ss
                ""
                )
       (command "oops")
       (princ "\n继续选择写块物体<右键结束>:")
       )
     )
    )
  (setvar 'cmdecho cmdecho)
  (princ)
  )
2:秋枫大侠的批量打印-分图工具

司徒妙嘉

血司 发表于 2017-11-30 08:55
(setq wz (ssget "WP" pts (list '(0 . "TEXT"))))

2. (defun c:ftc ( tcont pt / n ent enttype)
   
3.         (setq pt (ssget)
   
4.                 n 0
   
5.                 ent (ssname pt n)
   
6.                 enttype (cdr (assoc 0 (entget ent)))
   
7.         )
   
8.         (while (/= enttype "TEXT")
   
9.                 (setq n (1+ n))
   
10.                 (setq ent (ssname pt n)
    
11.                         enttype (cdr (assoc 0 (entget ent)))
    
12.                 )
    
13.                 ;(princ n)
    
14.                 ;(princ ent)
    
15.                 ;(princ enttype)
    
16.                 ;(princ "\n")
    
17.         )
    
18.         (setq tcont (cdr (assoc 1 (entget ent))))
    
19.         (command "wblock" pt (strcat "C:\Users\Onca\Desktop" tcont ".dwg")
    
20. )

(defun c:ftc ( tcont pt / n ent enttype)<br />         (setq pt (ssget)<br />                 n 0<br />                 ent (ssname pt n)<br />                 enttype (cdr (assoc 0 (entget ent)))<br />         )<br />         (while (/= enttype "TEXT")<br />                 (setq n (1+ n))<br />                 (setq ent (ssname pt n)<br />                         enttype (cdr (assoc 0 (entget ent)))<br />                 )<br />                 ;(princ n)<br />                 ;(princ ent)<br />                 ;(princ enttype)<br />                 ;(princ "\n")<br />         )<br />         (setq tcont (cdr (assoc 1 (entget ent))))<br />         (command "wblock" pt (strcat "C:\Users\Onca\Desktop" tcont ".dwg")<br /> )

我取到了需要独立成图形文件(pt), 以及命名该文件的用的文件名就是框选内容中的问题内容(tcont),
我该怎么把这两个参数给到"wblock"就是上面代码最后一句.

Kye

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=34825&mobile=2

Andyhon

...能不能实现?...


...总图中一个个复制到另一个空白的文件中...
这段改用 WBlock 能行吗?

若可行,编程不难...
欠调试用文件(Dwg),未有定论

司徒妙嘉

Andyhon 发表于 2017-11-25 18:57
...能不能实现?...

以块保存,只在后续工作的其中一种软件(最主要的)中能识别, 另外两个无法识别. 结论能不用块最好不用, 无它法那也只能接受.
测试文件已上传, dxf格式, 应该问题不大吧?

Andyhon

不用块时则需改用 留己删它 -->另存 -->oops
这样文件通常较大

司徒妙嘉

Andyhon 发表于 2017-11-27 09:47
不用块时则需改用 留己删它 -->另存 -->oops
这样文件通常较大

目前我用的手工方法
总图复制 --> 粘贴到另一个空白空间 --> 另存 --> 删除图形   如此循环
你说的块怎么说, 请赐代码

Andyhon

如例图若再规范些,比如文字皆在框内
应可以全自动另存

有些文字皆在框外则又得补判断式...
这部份套院长的函数会少些代码...

司徒妙嘉

Andyhon 发表于 2017-11-27 11:26
如例图若再规范些,比如文字皆在框内
应可以全自动另存

文字不在图形内毕竟还算少数, 如果我手动调整一下, 就能一下子全部另存完毕, 我就很满意啦.
院长代码是只2楼发的地址里面的代码吗? 我不是很看得懂吗, 能给我讲下基本原理吗?
另外, 如果不考虑文字, 就单纯将图形一个一个另存, 保存文件名另外以一定命名规则, 字符串拼接的方式, 要怎么实现?

Andyhon

AutoCAD 批量打印程序的思路应可借鉴

司徒妙嘉

Andyhon 发表于 2017-11-27 12:33
AutoCAD 批量打印程序的思路应可借鉴

你这把文字弄个一个图片, 让我去哪里借鉴? 自行百度吗?