hoodpinrh 发表于 2020-8-20 14:31:56

求大神優化一下

這是我在用的wblock,雖然不能批量另存。
但也滿好用的,目前想要慢慢的讓這個小程式優化一下。
求大神優化一下,也讓我可以好好的學習並改進我的缺點。

(defun c:WW (/ text1 ss text1_data text1_type text2_data text3_data)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "expert" 2)
(setq oldlay (getvar "clayer"))
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq path (getvar "dwgprefix"))
(setq i 0)
(while
    (and
      (setq text1 (entsel "\n選取儲存檔名:"))
       (setq ss (ssget))
    )
   (setq text1_data (entget (car text1)))
   (setq text1_type (cdr (assoc 0 text1_data)))
   (if
       (= text1_type "TEXT")
       (progn
       (setq text2_data (cdr (assoc 1 text1_data)))
       (setq text3_data (cdr (assoc 10 text1_data)))
       (command "-wblock"
                  (strcat path text2_data)
                  ""
                  text3_data
                  ss
                  ""
       )
       (command "undo" 1)
       )
       )
    )
(setvar "osmode" 47)
(princ)
)

gaics 发表于 2020-8-20 16:03:12

本帖最后由 gaics 于 2020-8-20 16:38 编辑

个别变量未声明为局部变量,如path,i......
修改的系统变量未还原;
(vl-load-com)多余;
(setq i 0)也没起到什么作用;
......

如果要批量,我可能会这么做:弄一个属性块,类似于图框,把要写出的内容一一框起来。然后ssget这些图框,从而获取文件名、基点,批量写出。

血司 发表于 2020-8-20 16:46:48

本帖最后由 血司 于 2020-8-20 16:54 编辑

(defun c:lxy (/ f_name path pt ss str)
(setq path (getvar "dwgprefix"))
(while(and
         (setq f_name (sel_fi "\n请选择存档名:" "TEXT"))
         (setq ss (ssget))
      )
    (setq str (Vlax-Get (Vlax-Ename->Vla-Object f_name) 'TextString )
            pt (Vlax-Get (Vlax-Ename->Vla-Object f_name) 'InsertionPoint )
   )
    (command "-wblock" (strcat path str) "" pt ss "")
    (command "undo" 1)
)
(princ)
)
(defun sel_fi (msg f)
      (while (if (setq el (car (entsel msg)))
         (if (= (cdr (assoc 0 (entget el))) f) nil t)
             nil)) el
)
(princ)

ZZXXQQ 发表于 2020-8-20 16:49:42

(defun c:WW (/ text1 ss text1_data text2 pt)
(setvar "cmdecho" 0)
(setvar "expert" 2)
(setq oldlay (getvar "clayer"))
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq path (getvar "dwgprefix"))
(setq i 0)
(while (and
         (setq text1 (entsel "\n選取儲存檔名:"))
         (setq ss (ssget))
      )
(setq text1_data (entget (car text1)))
(if (= (cdr(assoc 0 text1_data)) "TEXT") (progn
   (setq text2 (cdr (assoc 1 text1_data)))
   (setq pt (cdr (assoc 10 text1_data)))
   (command "-wblock" (strcat path text2) "" pt ss "")
   (command "u")
))
)
(setvar "osmode" 47)
(setvar "CMDECHO" 1)
(setvar "clayer" oldlay)
(princ)
)

hoodpinrh 发表于 2020-8-20 17:31:59

gaics 发表于 2020-8-20 16:03
个别变量未声明为局部变量,如path,i......
修改的系统变量未还原;
(vl-load-com)多余;


我有想過用有屬性的圖框,但因為我是從事鈑金雷射的行業。在物件多時,沒法改為批量的。
還感謝大神的指教,本人會在修改程式的。

hoodpinrh 发表于 2020-8-20 17:36:49

血司 发表于 2020-8-20 16:46
(defun c:lxy (/ f_name path pt ss str)
(setq path (getvar "dwgprefix"))
(while(and


感謝大神的指教,我又學到了一點知識。

hoodpinrh 发表于 2020-8-20 17:37:57

ZZXXQQ 发表于 2020-8-20 16:49
(defun c:WW (/ text1 ss text1_data text2 pt)
(setvar "cmdecho" 0)
(setvar "expert" 2)


謝謝指教,我知道我美中不足的地方了。感謝

gaics 发表于 2020-8-20 17:44:55

本帖最后由 gaics 于 2020-8-21 09:34 编辑

我写了一个,仅供参考

hoodpinrh 发表于 2020-8-21 00:39:52

gaics 发表于 2020-8-20 17:44
我写了一个,仅供参考

感謝大神提供屬性類的例子,太受用了。
我再思考一下,我要如何加入屬性類的東西。
我有用過朋友提供的LISP,朋友的LISP主要是提取屬性內容,並畫出表格的BOM表。

hoodpinrh 发表于 2020-8-23 16:12:46

各位大神,我這個小程序可以再什麼地方加上另存的的動作?在儲存dwg檔同時也另存為dxf,有辦法這樣嗎?
页: [1]
查看完整版本: 求大神優化一下