- 积分
- 22460
- 明经币
- 个
- 注册时间
- 2011-3-6
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|

楼主 |
发表于 2015-8-17 09:34:55
|
显示全部楼层
 - ;;; ;BA.lsp -BACKGROUND FILL ALL-
- ;;; ;Made for M3 Mexicana. Coding Selected by Paulo Gil Soto. December 2009
- ;;; ;This routine will set a background color fill to all selected text,
- ;;; ;mtext and dimensions, text objects will be converted to mtext with width=0
- ;;; ;and then will add their text box control points
- ;;; ;It will bring objects in layer 'Dims' to front at the end, as well as other
- ;;; ;Draworder operations according to M3 standards.
- ;;; ;Reviewed and modified by: Alan J. Thompson. 'alanjt@gmail.com'
- ;;; ;And Marco Antonio Jacinto Perez 'mcoan001@hotmail.com'
- ;;; ;December 2009
- ;;;
- ;;;文子避让
- (VL-LOAD-COM)
- (DEFUN c:BA (/ *error* ttm2 ss elist sel1 sel3 dimt)
- ;;; error handler
- (DEFUN *error* (#Message)
- (AND dimt (SETVAR "dimtfill" dimt))
- (AND #Message
- (NOT (WCMATCH (STRCASE #Message) "*BREAK*,*CANCEL*,*QUIT*"))
- (PRINC (STRCAT "\nError: " #Message))
- ) ;_ and
- ) ;_ defun
- ;; Using code from Roberto Gonzalez -robierzogg- from HISPACAD
- ;; http://www.hispacad.com/foro/viewtopic.php?p=142823&sid=b23c3147d2a06a29d1dfd60078f79c08
- ;; This routine works only if Express tools are installed
- ;; Convert selected text into Mtext
- (COMMAND "undo" "begin") ;beginning of undo group
- (DEFUN ttm2 (name_n / collect n name_n insertpt name_n1 newlist)
- (SETQ insertpt (ASSOC 10 (ENTGET name_n)))
- ; Convert Text to Mtext, using the
- ; EXPRESS
- ; command
- (COMMAND "txt2mtxt" name_n "")
- ; We set their original insertion point
- ; here
- ;;;creo que esta parte mueve los nuevos mtextos de posicion hacia arriba
- ;;;no se por que lo pusieron?
- (SETQ name_n1 (ENTLAST))
- (SETQ newlist (SUBST insertpt
- (ASSOC 10 (ENTGET name_n1))
- (ENTGET name_n1)
- )
- )
- (ENTMOD newlist)
- (SETQ newlist (SUBST '(71 . 7)
- (ASSOC 71 (ENTGET name_n1))
- (ENTGET name_n1)
- )
- )
- (ENTMOD newlist)
- (SETQ newlist (SUBST '(46 . 0)
- (ASSOC 46 (ENTGET name_n1))
- (ENTGET name_n1)
- )
- )
- (ENTMOD newlist)
- (SETQ newlist (SUBST '(41 . 0)
- (ASSOC 41 (ENTGET name_n1))
- (ENTGET name_n1)
- )
- )
- (ENTMOD newlist)
- ) ;_ defun
- ;;; Aqui pongo la variable Mtexts como un parametro, el cual corresponde al ss
- ;;; que vas creando con los nuevos Mtextos
- (DEFUN mw5 (mtexts / mtexts idx ename EntData dxf42 dxf43 EntData1)
- ;Reset Width - Mtext
- (IF mtexts
- ;; Aqui se hace el cambio para que en lugar
- ;; de cambiar todos los mtextos, solo modifique los que recien creaste
- ;; (setq mtexts (ssget "_X" '((0 . "MTEXT"))))
- ;; Rogerio Brazil from an autodesk Discussion groups
- ;; http://discussion.autodesk.com/forums/thread.jspa?messageID=6339167&tstart=0
- (PROGN
- (SETQ idx 0)
- (REPEAT (SSLENGTH mtexts)
- (SETQ ename (SSNAME mtexts idx))
- (SETQ EntData (ENTGET ename '("*")))
- (SETQ dxf42 (* (CDR (ASSOC 42 EntData))1.07))
- (SETQ dxf43 (CDR (ASSOC 43 EntData)))
- (SETQ EntData1
- (ENTMOD (SUBST (CONS 41 dxf42) (ASSOC 41 EntData) EntData))
- )
- (ENTMOD (SUBST (CONS 46 dxf43) (ASSOC 46 EntData1) EntData1)
- )
- (SETQ idx (1+ idx))
- ) ;progn
- ) ;repeat
- (PRINC "\n Null Selection!")
- ) ;if
- (PRINC)
- )
- ;;
- ;;
- ;; ; MAIN ROUTINE
- ;;
- ;;
- ;; Some part of code from Tom Beauford, from AUGI
- ;; http://forums.augi.com/showthread.php?t=77962
- ;; Set 'Border Offset Factor' to 1.15
- (SETQ dimt (GETVAR "dimtfill"))
- (SETVAR "dimtfill" 1)
- (PRINC
- "\nSelect Dimensions and text to apply the background fill and update...: "
- )
- (AND (SETQ ss (SSGET "_:L" '((0 . "MTEXT,*DIMENSION*,TEXT"))))
- (FOREACH x (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX ss)))
- (COND
- ((EQ "DIMENSION" (CDR (ASSOC 0 (SETQ elist (ENTGET x)))))
- (VLA-PUT-TEXTFILL
- (VLAX-ENAME->VLA-OBJECT x)
- :VLAX-TRUE
- )
- (ENTMOD elist)
- )
- ((EQ "MTEXT" (CDR (ASSOC 0 (SETQ elist (ENTGET x)))))
- (VLA-PUT-BACKGROUNDFILL
- (VLAX-ENAME->VLA-OBJECT x)
- :VLAX-TRUE
- )
- (SETQ elist (SUBST (CONS 41 0.0) (ASSOC 41 elist) elist)
- elist (SUBST (CONS 46 0.0) (ASSOC 46 elist) elist)
- elist (SUBST (CONS 45 1.15) (ASSOC 45 elist) elist)
- elist (SUBST (CONS 421 256) (ASSOC 421 elist) elist)
- ) ;_ setq
- (ENTMOD elist)
- )
- ((EQ "TEXT" (CDR (ASSOC 0 (ENTGET x))))
- (ttm2 x)
- (SSDEL x ss)
- (VLA-PUT-BACKGROUNDFILL
- (VLAX-ENAME->VLA-OBJECT (SETQ elist (ENTLAST)))
- :VLAX-TRUE
- )
- (SSADD elist ss)
- (SETQ elist (ENTGET elist))
- (SETQ elist (SUBST (CONS 45 1.15) (ASSOC 45 elist) elist)
- elist (SUBST (CONS 421 256) (ASSOC 421 elist) elist)
- ) ;_ setq
- (ENTMOD elist)
- )
- (T T)
- ) ;_ cond
- ) ;_ foreach
- (VL-CMDF "_.-dimstyle" "_apply" ss "")
- (VL-CMDF "_.draworder" ss "" "_f")
- ) ;_ and
- (setq
- BkLst
- '("CENTER LINE2" "COLUMN ROW BUBBLE2" "DETAIL BUBBLE 12"
- "DETAIL BUBBLE2" "DUST PICK UP POINT2" "EQUIPMENT TAG2"
- "FULL SECTION LR2" "FULL SECTION UD2" "FULL SECTION2"
- "MATCH LINE SP2" "MATCH LINE2" "NORTH ARROW2"
- "NOTE BOX2" "NOTE ENCL2" "PARTIAL SECTION T2"
- "PARTIAL SECTION2" "PLATE2" "REVISION2"
- "SAMPLE NUMBER2" "SECTION CUT UD2" "SECTION CUT2"
- "STAMP BIG2" "STAMP SMALL2" "STREAM NUMBER2"
- "STREAM SEQUENCE2" "TAG2" "TITLE 12"
- "TITLE BUBBLE 12" "TITLE BUBBLE2" "TITLE2"
- "WORK POINT2" "ROOMTAG" "ROOMTAG2" "DOORTAG"
- "WALLTAG" "WINDOWTAG" "MULTIPLE DETAIL"
- "IND WALL CEIL 1" "IND WALL UP 1" "IND WALL L 1"
- "IND WALL R 1" "IND WALL DN 1" "MULTIPLE DETAIL"
- )
- NomBloques (car BkLst)
- BkName (mapcar '(lambda (x)
- (setq NomBloques (strcat NomBloques "," x))
- )
- (cdr BkLst)
- )
- )
- (if (setq sel5 (ssget "_X" (list '(-4 . "<OR")
- ; _Se seleccionan todos los bloques de
- ; usuario, despues se procesaran los
- ; nombres esto para poder procesar los
- ; bloques dinamicos
- '(-4 . "<AND")
- '(0 . "INSERT")
- (cons 2 (strcat NomBloques ",`*U*"))
- '(-4 . "AND>")
- '(-4 . "OR>")
- )
- )
- )
- (VL-CMDF "_.draworder" sel5 "" "_f")
- ) ;_ if
- (IF (SETQ sel4
- (SSGET
- "_X"
- '((0
- .
- "line,lwpolyline,insert,polyline,arc,circle,spline,hatch,region"
- )
- )
- )
- )
- (VL-CMDF "_.draworder" sel4 "" "_b")
- ) ;_ if
- (IF (SETQ sel1 (SSGET "_X" '((0 . "leader,*Dimension*"))))
- (VL-CMDF "_.draworder" sel1 "" "_f")
- ) ;_ if
- (IF (SETQ sel3
- (SSGET "_X"
- '((0 . "line,lwpolyline,polyline")
- (8 . "Dims,Ar-Dims,G-Dims,M-Dims,E-Dims,S-Dims,P-Dims")
- )
- ) ;_ ssget
- ) ;_ setq
- (VL-CMDF "_.draworder" sel3 "" "_f")
- ) ;_ if
- (SETVAR "dimtfill" dimt)
- (PRINC)
- (COMMAND "undo" "end") ;end of undo group
- (mw5 ss)
- ) ;_ defun
- (PRINC
- "\Type "BA" to mask all text, mtext and dimensions, adding mtext box"
- )
- ;|?Visual LISP? Format Options?
- (80 2 40 2 nil "end of " 60 9 2 0 0 T T T T)
- ;*** DO NOT add text below the comment! ***|;
|
|