fabriciorby 发表于 2022-7-6 06:40:48

布局处理

你好
我正在做一个项目,它有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)
        )
)
请,谁来帮帮我):

Lee Mac 发表于 2022-7-6 06:52:09

我建议如下:

(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)

BIGAL 发表于 2022-7-6 07:02:55

非常好,谢谢你们(:
现在我正在搜索如何在布局中选择块。。。
;; 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))))

fabriciorby 发表于 2022-7-6 07:20:14

在选择块时使用这种过滤器是可以的。。。
但是当我需要选择文本时,它不起作用。
我试着做这样的事情:

(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
)

fabriciorby 发表于 2022-7-6 07:24:23

 
当使用图形ssget选择方法(例如窗口/交叉/多边形)时,则不适用,因为要选择的对象必须在屏幕上可见;但是,当使用ssget“X”模式在图形数据库上迭代时,可以在ssget过滤器列表中包括DXF组410的过滤器,例如:
 

(command "layout" "s" layout)

Lee Mac 发表于 2022-7-6 07:38:09

嗯,
多么卑鄙):
 
感谢您的帮助(:

fabriciorby 发表于 2022-7-6 07:48:54

页: [1]
查看完整版本: 布局处理