[討論]分享常用鋼鐵及螺絲動態圖塊insert

主題回顧 :

小弟由於工作需求自製
提供給有需要的人

使用說明:
1.解壓縮後將Autolisp及Lisp資料夾放到D碟中
2.開啟CAD 設定搜尋支援檔可讀取LISP資料夾
3.Autolisp資料夾路徑必須為"D:\\AutoLisp\\sample.dwg"(路徑檔名均為絕對 不可更改)
4.sample.dwg為動態圖塊存放用檔案
5.support應用程式內含以下:
 (1) steel
      快速插入常用鋼鐵

 (2) screw
      快速插入常用螺絲 (圓頭平頭寫反了，請大家看圖片吧!!)


6.CAD指令欄中鍵入steel 或 screw 會彈出如上圖所示的畫面 即可選擇要插入的圖塊
7.插入後自行點擊可見性修改為須要的尺寸

▼載點如下(*回覆可見*)：


104.10.19
附上LISP原始檔案
之所以做成VLX檔起因是因為公司同事大部分也看不懂這些東西 也不會有修改上的需求
且另一方面為了方便新增程式或更新程式!
但因平時工作繁忙僅利用閒暇時間抽空撰寫，故內容部分可能稍嫌雜亂還請見諒
歡迎有需求的自行下載修改

也祝大家工作順利!! 心想事成!!

特別感謝:
關於""複製非打開圖檔的特定圖塊至當前圖面""這段程式碼
是在本論壇中向"明~"大討教而來

▼LISP及DCL檔案下載(回覆可見)

---

Tiger&蘋果爸 寫到: 謝謝熱心程式分享~< 積分 +1>
[公告]關於團隊成員的回文及貢獻

讓CAD變得更簡單快速

感謝 分享 工作上剛好有需求

感謝您的分享
畫大樣祥圖真的很需要
謝謝你

感謝分享

為了這個圖特別研究論壇怎麼回覆!
樓主一生平安!

sarah001231 寫到:為了這個圖特別研究論壇怎麼回覆!
樓主一生平安!

你的努力特別研究不會白費，論壇資源豐富喔~

剛好工作需要，非常感謝提供!!

太厲害了 感謝分享

謝謝前輩的分享

太厲害了 對於初學者的我 真是大有幫助 感謝

正好在尋找螺絲的圖 謝謝無私分享

謝謝您的分享,下載學習

感謝分享
工作相關圖塊剛好可用看看

感恩熱心並且無私分享～

感謝分享，工作非常需要~

太棒了!! 找這東西很久了~~謝謝大大分享

謝謝分享，搜尋相關資料看到，太棒了

感謝各位先進分享, 感謝再感謝

感謝分享，剛好廠商有叫我畫羅斯的圖塊

感謝分享,學習學習LISP寫法.


---------------------------------
想請問一下
;;公用函數7 (copyblock)
;;用 途：複製非打開圖檔的特定圖塊至當前圖面

這個有辦法修改成複製非打開圖檔的"所有圖元"至當前圖面嗎?

有10年沒有研究lisp了,下載來看看, 謝謝!

Conquerable 寫到:感謝分享,學習學習LISP寫法.


---------------------------------
想請問一下
;;公用函數7  (copyblock)
;;用    途：複製非打開圖檔的特定圖塊至當前圖面

這個有辦法修改成複製非打開圖檔的"所有圖元"至當前圖面嗎?

貼個主程序,你可改改

代碼:


;; ObjectDBX Example, by Lee McDonnell
;; Credit to Tony Tanzillo, Tim Willey

(defun C:ODBX (/ *ERROR* *ACAD SHELL FDIR DIR DWLST DBX RSLTLIST)
  (vl-load-com)

  ;; Error Handler

  (defun *ERROR* (E)
    (OBJREL (list SHELL DBX *ACAD))
    (if (not (wcmatch (strcase E) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n<< Error: " E " >>"))
    )
    (princ)
  )

  ;; Get Directory

  (setq *ACAD (vlax-get-acad-object)
 SHELL (vla-getinterfaceobject *ACAD "Shell.Application")
 FDIR  (vlax-invoke-method
 SHELL
 'BROWSEFORFOLDER
 (vla-get-hwnd *ACAD)
 "Select Directory: "
 80
      )
  )
  (and (eq (type SHELL) 'VLA-OBJECT)
       (not (vlax-object-released-p SHELL))
       (vl-catch-all-apply 'vlax-release-object (list SHELL))
  )
  (if FDIR
    (progn
      (setq DIR
     (vlax-get-property
       (vlax-get-property FDIR 'SELF)
       'PATH
     )
      )
      (if (not (eq "\\" (substr DIR (strlen DIR))))
 (setq DIR (strcat DIR "\\"))
      )
      (princ "\nProcessing...")

      ;; Iterate Drawings

      (foreach DWG (setq DWLST
  (mapcar
    (function
      (lambda (X)
 (strcat DIR X)
      )
    )
    (vl-directory-files DIR "*.dwg" 1)
  )
   )

 (vlax-for DOC (vla-get-documents *ACAD)
  (and (eq (strcase (vla-get-fullname DOC)) (strcase DWG))
       (setq DBX DOC)
  )
 )

 (and (not DBX)
     (setq DBX
    (vlax-create-object
      (if (< (setq ACVER (atoi (getvar "ACADVER"))) 16)
 "ObjectDBX.AxDbDocument"
 (strcat "ObjectDBX.AxDbDocument." (itoa ACVER))
      )
    )
     )
 )

 (if (not (vl-catch-all-error-p
   (vl-catch-all-apply 'vla-open (list DBX DWG))
 )
    )
  (progn

    ;; T.Willey
            ;; 別人寫了開頭 FUNC 只好自已寫
    (setq RSLTLIST
   (cons
     (cons DWG
   (FUNC DBX)
     )
     RSLTLIST
   )
    )

    ;; ---------

  )
 )

 (princ (chr 46))
      )

      ;; Ending Messages

      (princ (strcat "\n<< "
     (rtos (length DWLST) 2 0)
     " Drawings Processed >>\n "
     )
      )
    )
    (princ "*Cancel*")
  )

  ;; Garbage Collection

  (gc)
  (OBJREL (list SHELL DBX *ACAD))
  (reverse RSLTLIST)
)

;; Release Objects ~ Requires List of Variables

(defun OBJREL (LST)
  (mapcar
    (function
      (lambda (X)
 (if (and (eq (type X) 'VLA-OBJECT)
 (not (vlax-object-released-p X))
    )
  (vl-catch-all-apply
    'vlax-release-object
    (list X)
  )
 )
      )
    )
    LST
  )
)

;;對未開圖檔要做甚麼??
;;By LUCAS_LAI
;;想做甚麼??-->把未打開圖檔中
;;                   圖塊/圖層/字型/......copy到目前圖檔
;;Sorry!只列出圖檔中的圖塊名稱
;;https://www.autocad-tw.com/t19440-topic
(defun FUNC (DBX / BLOCKS_NAME_LIST BLK DBXBLOCKS_LIST)
  (setq DBXBLOCKS_LIST (vla-get-blocks DBX))
  (vlax-for BLK DBXBLOCKS_LIST
    (setq BLOCKS_NAME_LIST
   (append BLOCKS_NAME_LIST (list (vla-get-name BLK)))
    )
  )
)
(princ)


https://drive.google.com/file/d/1qKLtEE_4NGVxx8PtE4uKP9fovNNa9fCQ/view?usp=sharing
ObjectDBX Example.LSP

感謝分享如此實用的資源

感謝分享，超級需要的~

太感謝嚕~~

感謝分享