Diskuzní fórum

na toto je zpusob nikoli pres REFEDIT, ale pres LISP:

;;;Example of using Dean's program on all Inserts
;;;on a given layer

(defun c:PRAC (/ YN clr lyr)
   (initget "Yes No")
   (setq YN  (getkword "\nChange entities to layer 0 <No>: "))
   (setq clr (acad_colordlg 256))
   (setq lyr "Center")
   (BCOLORSSX YN clr lyr)
   (princ)
)

(defun BCOLORSSX (yn clr lyr / ss idx eg1 nam en2)
  (if (tblsearch "Layer" lyr)
    (progn (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 8 lyr))))
    (setq idx 0)
    (repeat (sslength ss)
      (setq eg1 (entget (ssname ss idx)))
      (setq nam (cdr (assoc 2 eg1))
     en2 (cdr (assoc -2 (tblsearch "BLOCK" nam)))
      )
      (prblk en2 nam)
      (setq idx (1+ idx))
    )
    )
    (alert (strcat "Layer: " (strcase lyr) " not found!"))
  )
)

; TIP1127.LSP: BCOLOR.LSP    Change Block Color    (c)1995, Dean Langmaid
;**********Routine to change the color of a block**********
(defun C:BCOLOR (/ CLR CNT CMD EN1 EN2 EG1 EG2 NAM SS1 YN)
   (setq CMD (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   ;---Get the block to modify---
   (while (null EN1)
      (setq EN1 (entsel "\nSelect block to modify: "))
      (if EN1
         (progn
             (setq EN1 (car EN1)
                EG1 (entget EN1)
             )
             (if (= (cdr (assoc 0 EG1)) "INSERT")
                (redraw EN1 3)
                (progn
                   (redraw EN1 3)
                   (setq EN1 nil)
                   (princ "\nItem selected is not a block.")
                )
             )
         )

         (princ "\nNothing selected.  Try again.")
      )
   )
   ;---Check for layer change---
   (initget "Yes No")
   (setq YN (getkword "\nChange entities to layer 0 <No>: "))
   ;---Check for color---

   (while (null CLR)
      (initget "? RED YELLOW GREEN CYAN BLUE MAGENTA WHITE BYLAYER BYBLOCK")
      (setq CLR (getint "\nColor for entities/? for list/<BYLAYER>: ")
         CLR (cond ((null CLR) 256)
             ((and (= (type CLR) 'INT) (< -1 CLR 257)) CLR)
           ((= CLR "?") (LSTCDS))
             ((= CLR "RED") 1)
             ((= CLR "YELLOW") 2)
             ((= CLR "GREEN") 3)
             ((= CLR "CYAN") 4)
             ((= CLR "BLUE") 5)
             ((= CLR "MAGENTA") 6)
             ((= CLR "WHITE") 7)
             ((= CLR "BYBLOCK") 0)
             ((= CLR "BYLAYER") 256)
             (t  (and (princ "\nBad value, try again.") nil))
      ))
   )

   ;---Loop through entities in the block---
   (setq NAM (cdr (assoc 2 EG1))
      EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
   )
   (PRBLK EN2 NAM)

   (setvar "CMDECHO" CMD)
   (princ)
)
;*******Subroutine to change color and layer********
(defun PRBLK (EN2 NAM)
   (setq CNT 0)
   (while EN2
      (setq CNT (1+ CNT)
         EG2 (entget EN2)
         EN2 (entnext (cdr (assoc -1 EG2)))
      )
      (grtext -2 (strcat NAM " block entity # " (itoa CNT)))

      ;---Check for nested blocks---
      (if (= (cdr (assoc 0 EG2)) "INSERT")
         (progn
             (setq NM2 (cdr (assoc 2 EG2))
                EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
             )
             (PRBLK EN3 NM2)
         )

         (progn
             ;---Check color---
             (if (assoc 62 EG2)
                (setq EG2 (subst (cons 62 CLR) (assoc 62 EG2) EG2))
                (setq EG2 (append EG2 (list (cons 62 CLR))))
             )
             (entmod EG2)

             ;---Check layer---
             (if (and (= YN "Yes") (/= (cdr (assoc 8 EG2)) "0"))
                (progn
                   (setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
                   (entmod EG2)
                )
             )
         )
      )
   )
   ---Update all blocks in the drawing---
   (setq SS1 (ssget "X" (list (cons 2 NAM)));find all insertions of that block, if any
          CNT 0)
   (if SS1 (progn
         (setq C (- (sslength SS1) 1))  ; set counter
         (while (>= C CNT)  ; while entities in the list
      (setq EN1 (ssname SS1 CNT))
      (setq CNT (1+ CNT))
      (entupd EN1)
       );end while C
          );progn
   );if SS1
);defun

;********Subroutine to list the options*************
(defun LSTCDS ()
   (if textpage (textpage) (textscr))
   (princ "\n                                                             ")
   (princ "\n                   Color number   |   Standard meaning ")
   (princ "\n                  ________________|____________________")
   (princ "\n                                    |                      ")
   (princ "\n                           0        |      <BYBLOCK>     ")
   (princ "\n                           1        |      Red         &nb sp; ")
   (princ "\n                           2        |      Yellow        ")
   (princ "\n                           3        |      Green         ")
   (princ "\n                           4        |      Cyan          ")
   (princ "\n                           5        |      Blue          ")
   (princ "\n                           6        |      Magenta       ")
   (princ "\n                           7        |      White         ")
   (princ "\n                      8...255     |      -Varies-      ")
   (princ "\n                         256       |      <BYLAYER>     ")
   (princ "\n                                                       \n\n\n")
   (getint "\nColor number: ")
)

(princ "\n\tLoaded BCOLOR.LSP.  Type  BCOLOR  to begin.")
(princ); end bcolor.lsp

ufff, ja to dlouho nepouzil, spoustim myslim bud BCOLOR nebo pretazenim .lsp souboru do okna acadu - tento lisp mam proto, ze ho kdysi chtela nejaka nase profese a rikala, ze je s nim happy - ted jsem nasel jeste fixblock, to je pro vas asi lepsi:

 ;FIXBLOCK.LSP  [4/16/96]
 ;
 ; Copyright 1996 Manu-Soft Computer Services
 ;
 ; freeware by:
 ;   Owen Wengerd
 ;   Manu-Soft Computer Services
 ;   CompuServe:  71324,3252
 ;   owenw@nvi.nvi.net
 ;
 ; Load function, then enter FIXBLOCK to redefine selected blocks
 ;  so that all entities are on layer '0'.
 ;

(defun c:fixblock (/ ss cnt b donelist bredef)
  (defun bredef (b / e el)
    (setq e (tblobjname "BLOCK" b))
    (while e
      (setq el (entget e))
      (setq el (subst '(8 . "0") (assoc 8 el) el))
      (setq el (if (assoc 62 el) (subst '(62 . 0) (assoc 62 el) el) (append el '((62 . 0)))))
      (entmake el)
      (setq e (entnext e))
    )
    (if (/= "ENDBLK" (cdr (assoc 0 el))) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
  )
  (if (> (logand (cdr (assoc 70 (tblsearch "layer" "0"))) 1) 0)
    (princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
    (if (setq ss (ssget '((0 . "INSERT"))))
      (progn
        (setq cnt (sslength ss))
        (while (>= (setq cnt (1- cnt)) 0)
          (if (not (member (setq b  (cdr (assoc 2 (entget (ssname ss cnt))))) donelist))
             (progn
               (bredef b)
               (setq donelist (cons b donelist))
             )
          )
        )
        (princ (strcat "\n" (itoa (sslength ss)) " blocks redefined\n"))
      )
      (princ "\nNo blocks selected!\n")
    )
  )
  (princ)
)
;End-of-file

TIP1127.LSP: BCOLOR.LSP je perfektný pretože rieši aj vnorené bloky, čo fixblock nerobí.

Pustiť ho treba cez "PRAC" a predtým je potrebné nastaviť hladinu, ktorú má prehladávať viď. (setq lyr "Center") alebo to upraviť nech si ju vyžiada.

Dobrý den,
 tuto diskuzi sleduji jen tak bokem. Ale vyhledem k tomu, že se na to programování nikdo nehlásí, tak bych to zkusil. I klidně s tím dialogem.

Mohl by někdo prosím shrnout, co by to všechno mělo dělat?
A jaké volby by to mělo mít?
Co všechno by v tom dialogu mělo jít nastavit?

Pavel Štyl

Dotaz k tem blokum:
Co kdyz budu mit jeden blok ve vykrese vlozen 3x. Jednou bude v nezamcene hladine, podruhe v zamcene a potreti bude nekde jako blok v bloku.

Mam byt zpracovan nebo ne?

Původně odeslal(a) Petr Bláha No myslím, že pan Říha není troškař a vypsal to kompletně . Za sebe musí říci, že bych vystačil i s tím, aby ...

to, uznavam, asi nejsem - nechtel jsem ale, aby to pusobilo, ze se s chuti zakusuji do ruky, z niz byl nabidnut pouze prst:) - nicmene aspon za ten switch na vnorene bloky a ukladani uzivatelskych nastaveni bych rad byl:)