[求助]：寻找Dwg文件自动拆图软件开发人员

xyp1964

最初由 lemonx 发布
[B]xyp的程序很不错
不过美中不足，还有些小问题：
当所选择的路径中有重名文件时程序不能进行错误处理
路径名输入错误时也应该有提示
只能控制文件名前缀，而不能控制整个文件名，假如我的dwg文件中只有结1和结3，... [/B]

修改：
1、当所选择的路径中有重名文件时程序进行错误处理
2、路径名输入错误时提示错误并要求重新输入

2. [FONT=courier new]
   
3. ;;;ZDCT(自动拆图)
   
4. ;;;20060320
   
5. ;;;20060322修改
   
6. (defun c:ZDCT (/ ss i j s1 etype pts pte)
   
7.   (CMDLA0)
   
8.   (if (null STR)
   
9.     (setq STR "C:")
   
10.   )
    
11.   (if (null STR1)
    
12.     (setq STR1 "DRAW-")
    
13.   )
    
14.   (while (not (vl-directory-files
    
15.                 (SETQ STR (USTR 7 "\n存盘路径(C:/ls)" STR NIL))
    
16.               )
    
17.          )
    
18.     (princ "\n指定的存盘路径不存在, 请重新输入!")
    
19.   )
    
20.   (SETQ STR1 (USTR 7 "\n图名前缀" STR1 NIL))
    
21.   (princ "\n请选择图框或封闭外边框: ")
    
22.   (setq        ss (ssget)
    
23.         i  -1
    
24.         j  0
    
25.   )
    
26.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
27.     (setq etype (xyp-get-dxf 0 s1))
    
28.     (if        (= etype "INSERT")
    
29.       (wb-out s1)
    
30.       (progn
    
31.         (if (or        (= etype "POLYLINE")
    
32.                 (= etype "LWPOLYLINE")
    
33.             )
    
34.           (progn
    
35.             (setq pts (xyp-get-CurveStartPoint s1)
    
36.                   pte (xyp-get-CurveEndPoint s1)
    
37.             )
    
38.             (if        (equal pts pte)
    
39.               (wb-out s1)
    
40.               (princ "\n外框不封闭! ")
    
41.             )
    
42.           )
    
43.           (princ "\n外框不封闭! ")        ;非外边框
    
44.         )
    
45.       )
    
46.     )
    
47.   )
    
48. (if j
    
49.   (princ (strcat "\n共拆图 " (rtos j 2 0) " 个"))
    
50. )
    
51.   (CMDLA1)
    
52. )
    
53. (defun wb-out (sname / pt1 pt3 pt9)
    
54.   (setq        pt1 (xyp-get-MinMaxPoint sname 1)
    
55.         pt3 (xyp-get-MinMaxPoint sname 3)
    
56.         pt9 (xyp-get-MinMaxPoint sname 9)
    
57.         j   (1+ j)
    
58.         dn  (strcat str "/" STR1 (rtos j 2 0))
    
59.   )
    
60.   (while (findfile (strcat dn ".dwg"))
    
61.     (alert
    
62.       (strcat "\n文件 " dn " 已存在!" "\n新文件名为 " dn "-1")
    
63.     )
    
64.     (setq dn (strcat dn "-1"))
    
65.   )
    
66.   (command "wblock" dn "" pt3 "w" pt1 pt9 "")
    
67. )
    
68. (pxyp "ZDCT  (自动拆图)")
    
69. (princ)
    
70. [/FONT]

[FONT=courier new]<br /> ;;;ZDCT(自动拆图)<br /> ;;;20060320<br /> ;;;20060322修改<br /> (defun c:ZDCT (/ ss i j s1 etype pts pte)<br />   (CMDLA0)<br />   (if (null STR)<br />     (setq STR "C:")<br />   )<br />   (if (null STR1)<br />     (setq STR1 "DRAW-")<br />   )<br />   (while (not (vl-directory-files<br />                 (SETQ STR (USTR 7 "\n存盘路径(C:/ls)" STR NIL))<br />               )<br />          )<br />     (princ "\n指定的存盘路径不存在, 请重新输入!")<br />   )<br />   (SETQ STR1 (USTR 7 "\n图名前缀" STR1 NIL))<br />   (princ "\n请选择图框或封闭外边框: ")<br />   (setq        ss (ssget)<br />         i  -1<br />         j  0<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq etype (xyp-get-dxf 0 s1))<br />     (if        (= etype "INSERT")<br />       (wb-out s1)<br />       (progn<br />         (if (or        (= etype "POLYLINE")<br />                 (= etype "LWPOLYLINE")<br />             )<br />           (progn<br />             (setq pts (xyp-get-CurveStartPoint s1)<br />                   pte (xyp-get-CurveEndPoint s1)<br />             )<br />             (if        (equal pts pte)<br />               (wb-out s1)<br />               (princ "\n外框不封闭! ")<br />             )<br />           )<br />           (princ "\n外框不封闭! ")        ;非外边框<br />         )<br />       )<br />     )<br />   )<br /> (if j<br />   (princ (strcat "\n共拆图 " (rtos j 2 0) " 个"))<br /> )<br />   (CMDLA1)<br /> )<br /> (defun wb-out (sname / pt1 pt3 pt9)<br />   (setq        pt1 (xyp-get-MinMaxPoint sname 1)<br />         pt3 (xyp-get-MinMaxPoint sname 3)<br />         pt9 (xyp-get-MinMaxPoint sname 9)<br />         j   (1+ j)<br />         dn  (strcat str "/" STR1 (rtos j 2 0))<br />   )<br />   (while (findfile (strcat dn ".dwg"))<br />     (alert<br />       (strcat "\n文件 " dn " 已存在!" "\n新文件名为 " dn "-1")<br />     )<br />     (setq dn (strcat dn "-1"))<br />   )<br />   (command "wblock" dn "" pt3 "w" pt1 pt9 "")<br /> )<br /> (pxyp "ZDCT  (自动拆图)")<br /> (princ)<br /> [/FONT]

cy956

我也建议你去看看qf写的批量打印，可以以对话框选择某种类型实体作为图框，原码你在xdcad或mjtd上搜搜。

lemonx

我认为没必要搞那么复杂，
xyp现在的程序已经可以做到点一下拆一张图，而且已经可以做到自动识别矩形框和图块，非要为了少点几下让开发者一通忙乎，实在无此必要

xyp1964

可以建立新目录：

2. [FONT=courier new];;;ZDCT(自动拆图)
   
3. ;;;20060320
   
4. ;;;20060322修改
   
5. (defun c:ZDCT (/ ss i j s1 etype pts pte)
   
6.   (CMDLA0)
   
7.   (if (null STR)
   
8.     (setq STR "C:")
   
9.   )
   
10.   (if (null STR1)
    
11.     (setq STR1 "DRAW-")
    
12.   )
    
13.   (while (not (vl-directory-files
    
14.                 (SETQ STR (USTR 7 "\n存盘路径(C:/ls)" STR NIL))
    
15.               )
    
16.          )
    
17.     (setq ukw (UKWORD 7
    
18.                       "Y N"
    
19.                       "\n指定的存盘路径不存在，是否新建 : Y-新建/N-不建"
    
20.                       ukw
    
21.               )
    
22.     )
    
23.     (cond ((= UKW "Y") (vl-mkdir STR)))
    
24.   )
    
25.   (SETQ STR1 (USTR 7 "\n图名前缀" STR1 NIL))
    
26.   (princ "\n请选择图框或封闭外边框: ")
    
27.   (setq        ss (ssget)
    
28.         i  -1
    
29.         j  0
    
30.   )
    
31.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
32.     (setq etype (xyp-get-dxf 0 s1))
    
33.     (if        (= etype "INSERT")
    
34.       (wb-out s1)
    
35.       (progn
    
36.         (if (or        (= etype "POLYLINE")
    
37.                 (= etype "LWPOLYLINE")
    
38.             )
    
39.           (progn
    
40.             (setq pts (xyp-get-CurveStartPoint s1)
    
41.                   pte (xyp-get-CurveEndPoint s1)
    
42.             )
    
43.             (if        (equal pts pte)
    
44.               (wb-out s1)
    
45.               (princ "\n外框不封闭! ")
    
46.             )
    
47.           )
    
48.           (princ "\n外框不封闭! ")        ;非外边框
    
49.         )
    
50.       )
    
51.     )
    
52.   )
    
53.   (if j
    
54.     (princ (strcat "\n共拆图 " (rtos j 2 0) " 个"))
    
55.   )
    
56.   (CMDLA1)
    
57. )
    
58. (defun wb-out (sname / pt1 pt3 pt9)
    
59.   (setq        pt1 (xyp-get-MinMaxPoint sname 1)
    
60.         pt3 (xyp-get-MinMaxPoint sname 3)
    
61.         pt9 (xyp-get-MinMaxPoint sname 9)
    
62.         j   (1+ j)
    
63.         dn  (strcat str "/" STR1 (rtos j 2 0))
    
64.   )
    
65.   (while (findfile (strcat dn ".dwg"))
    
66.     (alert
    
67.       (strcat "\n文件 " dn " 已存在!" "\n新文件名为 " dn "-1")
    
68.     )
    
69.     (setq dn (strcat dn "-1"))
    
70.   )
    
71.   (command "wblock" dn "" pt3 "w" pt1 pt9 "")
    
72. )
    
73. (pxyp "ZDCT  (自动拆图)")
    
74. (princ)[/FONT]

[FONT=courier new];;;ZDCT(自动拆图)<br /> ;;;20060320<br /> ;;;20060322修改<br /> (defun c:ZDCT (/ ss i j s1 etype pts pte)<br />   (CMDLA0)<br />   (if (null STR)<br />     (setq STR "C:")<br />   )<br />   (if (null STR1)<br />     (setq STR1 "DRAW-")<br />   )<br />   (while (not (vl-directory-files<br />                 (SETQ STR (USTR 7 "\n存盘路径(C:/ls)" STR NIL))<br />               )<br />          )<br />     (setq ukw (UKWORD 7<br />                       "Y N"<br />                       "\n指定的存盘路径不存在，是否新建 : Y-新建/N-不建"<br />                       ukw<br />               )<br />     )<br />     (cond ((= UKW "Y") (vl-mkdir STR)))<br />   )<br />   (SETQ STR1 (USTR 7 "\n图名前缀" STR1 NIL))<br />   (princ "\n请选择图框或封闭外边框: ")<br />   (setq        ss (ssget)<br />         i  -1<br />         j  0<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq etype (xyp-get-dxf 0 s1))<br />     (if        (= etype "INSERT")<br />       (wb-out s1)<br />       (progn<br />         (if (or        (= etype "POLYLINE")<br />                 (= etype "LWPOLYLINE")<br />             )<br />           (progn<br />             (setq pts (xyp-get-CurveStartPoint s1)<br />                   pte (xyp-get-CurveEndPoint s1)<br />             )<br />             (if        (equal pts pte)<br />               (wb-out s1)<br />               (princ "\n外框不封闭! ")<br />             )<br />           )<br />           (princ "\n外框不封闭! ")        ;非外边框<br />         )<br />       )<br />     )<br />   )<br />   (if j<br />     (princ (strcat "\n共拆图 " (rtos j 2 0) " 个"))<br />   )<br />   (CMDLA1)<br /> )<br /> (defun wb-out (sname / pt1 pt3 pt9)<br />   (setq        pt1 (xyp-get-MinMaxPoint sname 1)<br />         pt3 (xyp-get-MinMaxPoint sname 3)<br />         pt9 (xyp-get-MinMaxPoint sname 9)<br />         j   (1+ j)<br />         dn  (strcat str "/" STR1 (rtos j 2 0))<br />   )<br />   (while (findfile (strcat dn ".dwg"))<br />     (alert<br />       (strcat "\n文件 " dn " 已存在!" "\n新文件名为 " dn "-1")<br />     )<br />     (setq dn (strcat dn "-1"))<br />   )<br />   (command "wblock" dn "" pt3 "w" pt1 pt9 "")<br /> )<br /> (pxyp "ZDCT  (自动拆图)")<br /> (princ)[/FONT]

doubao

作图规范化是实现自动化的必要条件。
在autocad2005/2006 里的sheetset manager 已经相当好用了。不过要求图框图签在图纸空间，而不是在模型空间。

国内cad制图似乎普遍都是直接在模型空间的。这样做其实有不少弊端。

jx2008

提几个小小建议：

1、怎么修改成把与图框相交的图元也一起保存，
2、或把与之相交的框外的直线、多线等在相交点断开，然后保存框内的图形，
3、或者通过用户框选的方式来学选择需要拆图的范围，
4、在保存之后，不应该把原始图中的图形删除，就是说原图还是毫发无损，完好无缺。

szx025

在保存之后，不应该把原始图中的图形删除，就是说原图还是毫发无损，完好无缺。
这一点很有必要.

flowerson

xyp1964  斑竹，你的程序很好！但如果是有布局的（模型画图，布局标注插入图框等）就不行了！

taner

用秋枫大侠的批打

longer1000

很好的功能

qiaqiadeng

强烈反对拆图，我们领导每次让我分图，我一边分一边骂，拆开后想修改就很麻烦，我真搞不懂他们是怎么想的，最后我得出一个结论：凡是没画过图的人就喜欢拆开，凡是不会用块的人就喜欢拆图，凡是脑子有毛病的人就喜欢拆开。。。不解恨，还想骂，不过没词了。虽然我有拆图工具，那是被逼着编出来的

reedmace

xyp1964 发表于 2006-3-23 14:16
可以建立新目录：

找不到PXYP函数