AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
[分享]鎖圖 Io15011 [分享]鎖圖 2020-310 [分享]鎖圖 Oiu15010 [分享]鎖圖 2020-211 [分享]鎖圖 Oo-2-110 [分享]鎖圖 BPl3tjj

[分享]鎖圖

向下

[分享]鎖圖 Empty [分享]鎖圖

發表 由 LUCAS_LAI 2021-07-23, 15:03

;;鎖圖
;;每5個圖元建立1個多重匿名圖塊
;;一半MINSERT轉到"Defpoints"層===>不能印圖
;;以上跑2次,最後再建成多重匿名圖塊
;;但對會編程的人,一點用都沒有,所以先炸開是基本功
;;保護智慧財產
https://www.autocad-tw.com/t131-topic?highlight=%E4%BF%9D%E8%AD%B7
;;低版本利用WMFOUT,WMFIN炸開圖檔
https://www.autocad-tw.com/t24947-topic
;;BY LUCAS_LAI

代碼:

(vl-load-com)
(defun C:QMBLK1 (/ A AA AAA AAL BLKS
 HOLDCLAYER HOLDECHO ;HOLDDIA HOLDREQ
 N OBJ QQ STIME ETIME
 )

  (defun DO_IT ()
    ;;慢速(因為使用了COMMAND建BLOCK),用VLISP建BLOCK同COMMAND,ENTMAKE建BLOCK(快4倍)
    (command "_.BLOCK" A "NON" '(0 0 0) AAA "")
    (setq OBJ (vla-item BLKS A))
    (vla-put-name OBJ "*U")
    (entmake (list '(0 . "INSERT")
   '(100 . "AcDbMInsertBlock")
   (cons 2 (vla-get-name OBJ))
   (cons 10 (trans '(0 0 0) 1 0))
   '(70 . 1)
   '(71 . 1)
     )
    )
  )

  (setq HOLDECHO (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.undo" "_group")
  (setq STIME (getvar "date"))
  (setvar 'QAFLAGS 0)
  ;;(setq HOLDDIA (getvar "ATTDIA"))
  ;;(setq HOLDREQ (getvar "ATTREQ"))
  (setq HOLDCLAYER (getvar "CLAYER"))
  (command "_.layer" "m" "Defpoints" "c" "7" "" "lt" "CONTINUOUS" "" "")
  (setvar "CLAYER" "0")
  (setq BLKS (vla-get-blocks
       (vla-get-activedocument (vlax-get-acad-object))
     )
  )
  ;;(setvar "ATTDIA" 0)
  ;;(setvar "ATTREQ" 0)
  (setq A (rtos (* (getvar "CDATE") 1E8)))
  ;;可多跑幾次,但太多次出圖就看不到東西
  ;;1次沒法達到不能印圖
  ;;至少2次才能達到不能印圖
  (repeat 2
    (if (setq AA (ssget "_X"
 (list '(0 . "~VIEWPORT")
      '(0 . "~ATTDEF")
      (cons 410 (getvar "CTAB"))
 )
 )
 )
      (progn
 (setq AAL (sslength AA))
 (setq N 0)
 (while (> AAL N)
  (setq AAA (ssadd))
  (repeat 5
    (if (ssname AA N)
      (ssadd (ssname AA N) AAA)
    )
    (setq N (1+ N))
  )
  (DO_IT)
  (if (= (rem N 2) 1)
    (progn
      (setq QQ (entget (entlast)))
      (setq QQ (subst '(8 . "Defpoints") (assoc 8 QQ) QQ))
      (entmod QQ)
    )
  )
 )
      )
    )
  )
  (setq AAA (ssget "_X"
   (list '(0 . "~VIEWPORT")
 '(0 . "~ATTDEF")
 (cons 410 (getvar "CTAB"))
   )
    )
  )
  (DO_IT)
  ;;(setvar "ATTDIA" HOLDDIA)
  ;;(setvar "ATTREQ" HOLDREQ)
  (setq ETIME (getvar "date"))
  (prompt
    (strcat
      "\n程式共耗用時間: "
      (rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME))))
    2
    3
      )
      "秒"
    )
  )
  (setvar "CLAYER" HOLDCLAYER)
  (vlax-release-object BLKS)
  (command "_.undo" "_end")
  (setvar "cmdecho" HOLDECHO)
  (princ)
)
(princ
  "\nType QMBLK1  COMMAND建圖塊鎖圖,BY LUCAS_LAI"
)
(princ)


QMBLK1.LSP下載
[回覆可見]

LUCAS_LAI
LUCAS_LAI
一般會員
一般會員

文章總數 : 33
年齡 : 56
來自 : 桃園市
職業 : 工程師
愛好 : 看動漫
個性 : 內向
使用年資 : 25年以上,但最近10年少用
使用版本 : 2011
經驗值 : 392
威望值 : 79
注冊日期 : 2021-05-27
男 摩羯座 龍

http://lucas-lai.ys168.com/

Tiger&蘋果爸 likes this post

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[分享]鎖圖 Uos15010 [分享]鎖圖 BPl3tjj [分享]鎖圖 Ziao1510 [分享]鎖圖 Oo-2-110 [分享]鎖圖 Oooo-110 [分享]鎖圖 2020-211