布局处理
你好我正在做一个项目,它有49个布局,它们的名字都是这样的:
01, 02, 03, 04, 05 ... 48, 49.
问题是:我不得不删除布局6,不幸的是,我应该逐个重命名所有层。
我试着编一个代码,但对我来说很困惑。。。
这是开始,我得到了一个所有层名称的列表。
(setq acadApp (vlax-get-Acad-object))
(setq acadDoc (vla-get-ActiveDocument acadApp))
(setq layouts (vla-get-Layouts acadDoc))
(vlax-for objLayout layouts
(if (not(=(vla-get-name objLayout) "Model"))
(setq laylist (cons(vla-get-name objLayout) laylist))
)
(setq laylist (reverse laylist))
这很烦人,因为我需要在数字中加0,比如
(if (< numero 10)
(progn
(setq numero (strcat "0" (itoa numero)))
(command "_layout" "d" numero)
)
(progn
(setq numero (itoa numero))
(command "_layout" "d" numero)
)
)
请,谁来帮帮我): 我建议如下:
(defun c:renlay ( / layouts order )
;; Layouts Collection
(setq layouts (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))))
;; Temporarily rename layouts to reduce risk of duplication when renumbering
(vlax-for layout layouts
(if (/= "MODEL" (strcase (vla-get-name layout)))
(vla-put-name layout (vla-get-handle layout))
)
)
;; Renumber layouts
(vlax-for layout layouts
(if (/= "MODEL" (strcase (vla-get-name layout)))
(vla-put-name layout
(if (< (setq order (vla-get-taborder layout)) 10)
(strcat "0" (itoa order))
(itoa order)
)
)
)
)
;; We were never here...
(princ)
)
(vl-load-com) (princ)
也可以先加载getval
; change the 410 to layout name
;;-------------------=={ Parse Numbers }==--------------------;;
;; ;;
;;Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;s - String to process ;;
;;------------------------------------------------------------;;
;;Returns:List of numerical values found in string. ;;
;;------------------------------------------------------------;;
(defun LM:ParseNumbers ( s )
(
(lambda ( l )
(read
(strcat "("
(vl-list->string
(mapcar
(function
(lambda ( a b c )
(if
(or
(< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
b 32
)
)
)
(cons nil l) l (append (cdr l) (list nil))
)
)
")"
)
)
)
(vl-string->list s)
)
)
(defun getline1-2 ()
(if (= tabname (nth 0 plotabs))
(progn
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
(if (= oldtag6 (strcase (vla-get-tagstring att)))
(setq newstr6 (vla-get-textstring att))
)
)
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
(if (= oldtag7 (strcase (vla-get-tagstring att)))
(setq newstr7 (vla-get-textstring att))
)
)
)
)
)
;(defun ah:sheetupdate1 (ss1 lay plotabs tabname dwgname)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
(setq plotabs (cons (vla-get-name lay) plotabs))
)
(setq plotabs (vl-sort plotabs '<))
(setq len (length plotabs))
(getline1-2) ; gets line 1&2 if not needed
(setq title "Please enter dwg number")
(setq width " edit_width = 15;")
(setq limit " edit_limit = 12;")
(ah:getval title width limit)
(setq dwgname item)
(setq TITLE "Please enter version for all sheets <Cr> no change ")
(setq width " edit_width = 8;")
(setq limit " edit_limit = 5;")
(ah:getval title width limit)
(setq NEWSTR4 item)
(setq TITLE "Do you want to use line 1 on all sheets OK no change any key for y")
(setq width " edit_width = 6;")
(setq limit " edit_limit = 3;")
(ah:getval title width limit)
(if (= item nil)
(setq NEWSTR6 nil)
(setq NEWSTR6yn "y")
)
(setq TITLE "Do you want to use line 2 on all sheets OK no change any key for y")
(setq width " edit_width = 6;")
(setq limit " edit_limit = 3;")
(ah:getval title width limit)
(if (= item nil)
(setq NEWSTR7 nil)
(setq NEWSTR7yn "y")
)
(setq x 0)
(setq bname "DA1DRTXT")
(repeat len
(setq tabname (nth x plotabs))
(if (/= tabname "Model")
(progn
(setvar "ctab" tabname)
(setq ss1 (ssget "x"(list (cons 0 "INSERT") (cons 2 bname)(cons 410 tabname))))
(setq dwgnum (Lm:parsenumbers tabname))
(setq sheetnum (car dwgnum))
(setq oldtag1 "SHT_NO") ;attribute tag name
(setq newstr1 (rtos sheetnum 2 0))
(setq oldtag2 "DRG_NO") ;attribute tag name
(setq oldtag3 "PROJ_NO") ;attribute tag name
(setq newstr3 dwgname)
(setq oldtag4 "REV_NO") ;attribute tag name
(setq oldtag6 "PROJECT_TITLE")
(setq oldtag7 "PROJECT_DESCRIPTION")
(getline1-2) ; gets line 1&2 if not needed
; if less than 10
(if (< (car dwgnum) 10.0)
(setq newstr2 (strcat dwgname "-D0"(rtos sheetnum 2 0)))
(setq newstr2 (strcat dwgname "-D"(rtos sheetnum 2 0)))
)
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1)
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2)
) ; end if
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr3)
) ; end if
(if (and (/= version nil) (= oldtag4 (strcase (vla-get-tagstring att))) )
(vla-put-textstring att newstr4)
) ; end if
(if (and (/= newstr6yn "Y") (= oldtag6 (strcase (vla-get-tagstring att))) )
(vla-put-textstring att newstr6)
) ; end if
(if (and (/= newstr7yn "Y") (= oldtag7 (strcase (vla-get-tagstring att))) )
(vla-put-textstring att newstr7)
) ; end if
) ; end foreach
) ; end progn
) ; end if
(setq x (+ x 1))
) ; end repeat
(setq ss1 nil)
(setq plotabs nil)
; end defun ah
(princ)
非常好,谢谢你们(:
现在我正在搜索如何在布局中选择块。。。
;; InputDialog box with variable title
;; By Ah June 2012
;; code (ah:getval title)
(defun AH:Getval (title width limit / fo)
(setq fname "C://acadtemp//getval.dcl")
(setq fo (open fname "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat " key = "(chr 34) "sizze" (chr 34) ";") fo)
(write-line(strcat " label = "(chr 34) title (chr 34) ";") fo)
; these can be replaced with shorter value etc
;(write-line " edit_width = 18;" fo)
;(write-line " edit_limit = 15;" fo)
(write-line width fo)
(write-line limit fo)
(write-line " is_enabled = true;" fo)
(write-line " }" fo)
(write-line "}" fo)
(write-line "ok_cancel;}" fo)
(close fo)
(setq dcl_id (load_dialog"c:\\acadtemp\\getval"))
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(action_tile "sizze" "(setq item$value)(done_dialog)")
(mode_tile "sizze" 3)
(start_dialog)
; returns the value of item
)
有更简单的方法吗?
(setq ss (ssget "x" '((0 . "INSERT")(2 . "CARIMBO")(410 . LAYOUTNAME)))) 在选择块时使用这种过滤器是可以的。。。
但是当我需要选择文本时,它不起作用。
我试着做这样的事情:
(setq ssfilter (list (cons 0 "INSERT")(cons 2 "CARIMBO")(cons 410 layname)))
(setq ss (ssget "x" ssfilter))
但这需要太长时间,我的意思是,有48个布局,计算机运行太慢/
有没有其他方法,每次都不改变布局?
它看起来像:
(setq pt1 '(989.303 304.802))
(setq pt2 '(1150.43 116.243))
(foreach y (layoutlist)
(setvar 'ctab y)
(setq ss (ssget "W" pt1 pt2 '((0 . "TEXT"))))
;some codding here
)
当使用图形ssget选择方法(例如窗口/交叉/多边形)时,则不适用,因为要选择的对象必须在屏幕上可见;但是,当使用ssget“X”模式在图形数据库上迭代时,可以在ssget过滤器列表中包括DXF组410的过滤器,例如:
(command "layout" "s" layout)
嗯,
多么卑鄙):
感谢您的帮助(:
页:
[1]