有没有快速输出dwg的程序

lengxiaxi

有没有快速输出dwg的程序

这个dxf输出的，来自论坛



(DEFUN C:DXF( / GRP PATH NAME)
(SETVAR "CMDECHO" 0)
(PRINC "\n 【以DXF格式输出】")
(PROMPT "\n请选择DXF输出的实体:")
(SETQ GRP (SSGET))
(SETQ PATH (GETVAR "DWGPREFIX")) ;获取FILEPATH
(SETQ NAME (GETFILED "DXF档案输出快选" PATH "dwg" 15))
(SETVAR "FILEDIA" 0)
(COMMAND "_DXFOUT" NAME "V" "R12" "O" GRP "" "")
(SETVAR "FILEDIA" 1)
(SETVAR "CMDECHO" 1)
(PRINC "\n OK !!!")
(PRINC)
)



选定图形后，输出到指定的路径。有时候想要在一张大图中，选取部分图形，输出为dwg的文件，有什么办法实现？

kozmosovia

多简单，wblock啊      

qazxswk

kozmosovia 发表于 2024-10-19 12:00
多简单，wblock啊

还有更简单的，一个W就可以搞掂了

专用车研发

用(command "-wblock")   写个程序就实现了
用你上边的程序修改一下

lengxiaxi

qazxswk 发表于 2024-10-19 23:02
还有更简单的，一个W就可以搞掂了

惭愧，还不知道有自带的，哈哈

感谢大佬指点

lengxiaxi

捉到源码一枚，特此补充；获取自cad自学网，大概率也是来自明经
觉得好用的，赏个免费的评分，系统每天赠送评分2币，不用也会过期哦！

;;==选物另存为DWG(W)=================================================================================================
(defun c:tt5 (/ dwgname n txt3 ss ppi date name time path filename )
        (setvar "cmdecho" 0) ;
  (setvar "OSMODE" 0)
                 (setq        dwgname    (getvar 'dwgname)
    n (VL-STRING-SEARCH "." dwgname)
    txt3 (strcat (substr dwgname 1 n) "_"))
  (setq ss (ssget )) ;选择集
  (setq ppi (mc:ssmind ss))
        (setq date (rtos (getvar "cdate") 2 6));系统当前时间
        (setq time (substr date 10 17))
  (setq name (getstring "\n输入保存名:<文件名+当前时间>"))
  (if (= name "")
                (setq name time)
                (setq txt3 "")
        )
        (setq path (strcat (vla-item (vlax-get (vlax-create-object "WScript.Shell" ) 'SpecialFolders) "Desktop") "\\"))    ;自动获取桌面路径
        (setq filename (strcat path txt3 name )) ;合并成文件路径及文件名       
         (if (= nil (vl-directory-files  path  (strcat txt3 name ".dwg")))
     (progn
    (command "WBLOCK" filename "" PPI  SS  "" "oops" )
          (PRINC (strcat "\n 成功 保存:" txt3 name  "到桌面！"))
                )
                 (progn
                  (mc:okno (strcat txt3 name))
                  (setq newname (vl-registry-read "HKEY_CURRENT_USER\\Software\\TH++\\" "name"))
                        (setq filename (strcat path newname ))
                  (vl-file-delete (strcat filename ".dwg" ))
                        (command "WBLOCK" filename "" PPI  SS  "" "oops" )
                 )
         )
        (setvar "cmdecho" 1)
        (PRINC)
)

(defun mc:okno (oldname / bb dcl_re f fname fsys jqm n zcm)
  (vl-load-com)
      (setq fname (vl-filename-mktemp "name.dcl") f (open fname "w"))
      (write-line "name:dialog{ label=\"文件已存在，重命名或覆盖\";" f)
      (write-line ":edit_box{label=\" 原名称\";key=\"e01\";edit_width=38;}" f)
      (write-line ":edit_box{label=\" 重命名\";key=\"e02\";edit_width=38;}" f)
      (write-line ":row{:button {label=\"确定\";key=\"e03\";is_default=true;}" f)
      (write-line ":button {label=\"取消\";is_cancel=true;}}}" f)
      (close f)
      (new_dialog "name" (setq dcl_re (load_dialog fname)))
      (set_tile "e01" oldname)
      (set_tile "e02" oldname)
      (action_tile "e03" "(setq newname  (get_tile \"e02\")) (done_dialog 1)")
      (if (= (start_dialog) 1)
                  (vl-registry-write "HKEY_CURRENT_USER\\software\\TH++\\" "name" newname)                       
            )
      (unload_dialog dcl_re)
      (vl-file-delete fname)                        
  (princ)
)

;两点中
(defun Mc:Md (pt1 pt2 / ptz)
        (setq ptz (mapcar'(lambda(X Y)(/(+ X Y)2.0)) pt1 pt2))
)


;;最小外包围点列表
(defun mc:wk (ss /  lst n obj minx miny maxx  maxy pt1 pt2 pt3 pt4)
  (repeat (setq n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    (vla-getboundingbox obj 'x 'y)
    (setq lst (cons (vlax-safearray->list y)
        (cons (vlax-safearray->list x) lst)
        )
    )
  )
  (setq  minx (car (vl-sort (mapcar 'car lst) '<))
  miny (car (vl-sort (mapcar 'cadr lst) '<))
  maxx (car (vl-sort (mapcar 'car lst) '>))
  maxy (car (vl-sort (mapcar 'cadr lst) '>))
  )
  (setq pt1 (list minx miny))
  (setq pt2 (list maxx miny))
  (setq pt3 (list maxx maxy))
  (setq pt4 (list minx maxy))
        (setq ptlist (list pt1 pt2 pt3 pt4))
)

;;选择集中心点****************************************************
(defun mc:ssmind (ss / pts ptz)
(setq pts (mc:wk ss))
(setq ptz (mc:md (car pts) (caddr pts)))
)