可悲的是。。。。 只是一些午餐的乐趣，让你开始。尽可能简单。所有这些都可以通过对话框和/或自动显示模板文件夹中的所有文件名等来完成。我想早点发布，但W10的重大更新让我在3-4个小时内什么都不做。
(defun c:Captain_Ahap( / SizeList ScaleList size scale titleblockfolder titleblock)
(vl-load-com)
; some shortcuts for titleblock / border sizes (without the full path)
(setq SizeList(list "A0" "A1" "A2" "A3" "A4-L" "A4-P")
ScaleList (list 1 10 50 100)
titleblockfolder "c:/temp/mytitleblockfolder/"
)
(if (and (setq size(CycleList "Choose titleblock size" SizeList))
(setq scale (CycleList "Choose titleblock scale" ScaleList)))
(progn
; maybe translate size to filename first
(cond ((eq size "A0") (setq titleblock (strcat titleblockfolder "A0_horizondal_test.dwg")))
((eq size "A1") (setq titleblock (strcat titleblockfolder "A1_horizondal_test.dwg")))
((eq size "A2") (setq titleblock (strcat titleblockfolder "A2_horizondal_test.dwg")))
((eq size "A3") (setq titleblock (strcat titleblockfolder "A3_horizondal_test.dwg")))
((eq size "A4-L") (setq titleblock (strcat titleblockfolder "A4_Landscape_test.dwg")))
((eq size "A4-P") (setq titleblock (strcat titleblockfolder "A4_Portrait_test.dwg")))
)
(if (and titleblock (findfile titleblock) (numberp scale))
(progn
(setvar 'expert 2) (setvar 'cmdecho 0) (setvar 'attreq 0)
(command "-insert" titleblock (list 0 0 0) scale scale 0)
(command "_.explode" "_L")
(command "-purge" "B" "YourBlockName" "N")
(command "._zoom" "e")
)
(alert "Unable to insert titleblock")
)
)
)
(princ)
)
; example1 (setq choise (CycleList "Choose titleblock size" '("A0" "A1" "A2" "A3" "A4")))
; example2 (setq choise (CycleList "Choose titleblock scale" '(1 10 50 100)))
(defun CycleList (msg lst / inp loop rtn)
(setq loop t)
(while loop
(princ "\nCycle list with tab or L-mouse / accept use enter,space or R-mouse / Esc or x for exit\n")
(princ (strcat "\r" msg " <" (vl-princ-to-string (car lst)) "> : "))
(setq inp (vl-catch-all-apply 'grread (list nil 8 0)))
(if (vl-catch-all-error-p inp)
(progn (princ "\nTitleblock insertion cancelled")(setq rtn nil loop nil))
(progn
(cond
;tab
((or (equal inp '(2 9))(= (car inp) 3))
(setq lst (append (cdr lst)(list (car lst))))
(princ (strcat "\r" msg " <" (vl-princ-to-string (car lst)) "> : ")))
;enter,space,r-mouse
((or (equal inp '(2 13)) (equal inp '(2 32))(= (car inp) 25))
(setq rtn (car lst) loop nil))
;x or X
((member inp '((2 88)(2 120)))(setq rtn nil loop nil))
)
)
)
)
(terpri)
rtn
)
; start command with (c:Captain_Ahap)
嗯，（工作）一天结束了，所以我走了。。。随着风（或波浪，因为你显然有一个可疑的东西；-）
gr.Rlx
谢谢你rlx。它工作得很好。将使用c中的“support”文件夹，而不是临时文件夹。
页:
1
[2]