2P Opublikowano 17 Maja 2011 Zgłoś Opublikowano 17 Maja 2011 Witam! Poszukuję LISPów (lub innych rozwiązań), które wykonają mi następujące czynności: 1. Usuną atrybuty z definicji bloku i z jego wystąpień w rysunku, bez rozeksplodowywania bloku. 2. Ustawią warstwę dla atrybutów we wskazanym wystąpieniu - taką jaka jest w definicji bloku. (Wyjaśnienie: Mamy wstawione do rysunku bloki z atrybutami na jakich "dzikich warstwach". Wchodzimy w edycję bloku zmieniamy warstwę dla wszystkich elementów, w tym atrybutów - np. na 0. Zapisujemy edytowany blok. Jednak w wystąpieniach bloku, atrybuty zachowują wcześniej zdefiniowaną warstwę, a ja chciałbym, żeby one przeniosły się na warstwę z bieżącej definicji bloku). Jak to zrobić? Nie uśmiecha mi się zmieniać tego "ręcznie" dla każdego argumentu osobno! Pozdr. Cytuj
Jason Opublikowano 19 Maja 2011 Zgłoś Opublikowano 19 Maja 2011 do 1: (defun C:DELA (/ OB OB# BL CMD) (vl-load-com) (if (setq OB (entsel "\nWskaz blok z ktorego usunac atrybuty: ")) (if (and (= (cdr (assoc 0 (entget (car OB)))) "INSERT") (setq OB# (vlax-Ename->vla-Object (car OB))) (setq BL (kr:BLK_GetBlockName OB#)) ) (progn (setq CMD (getvar 'CMDECHO)) (setvar 'CMDECHO 0) (foreach % (jk:BLK_Get-Objects BL "ATTDEF") (vla-Delete (vlax-Ename->vla-Object %)) ) (command "_attsync" "_S" (car OB) "_Y") (setvar 'CMDECHO CMD) ) ) (princ "\n** Nic nie wskazano **") ) (princ) ) ; ============================================================ ; ; Get block name ; ; Blk# - VLA block reference object ; ; ============================================================ ; (defun kr:BLK_GetBlockName (Blk#) (if (vlax-Property-Available-P Blk# 'EffectiveName) (vla-Get-EffectiveName Blk#) (vla-Get-Name Blk#) ) ) ; ============================================================ ; ; Funkcja zwraca liste ENAME, obiektow okreslonego typu (argu- ; ; ment ObjType, w definicji bloku (rowniez XREF) podanego jako ; ; argument Name ; ; (jk:BLK_Get-Objects "POM" "INSERT") ; ; ============================================================ ; (defun jk:BLK_Get-Objects (Name ObjType / En Ed res) (setq En (tblobjname "BLOCK" Name)) (while (and (setq En (entnext En)) (setq Ed (entget En)) (/= "ENDBLK" (cdr (assoc 0 Ed))) ) (if (= (cdr (assoc 0 Ed)) (strcase ObjType)) (setq res (append (list (cdr (assoc -1 ed)) ) res ) ) ) ) res ) (princ "\n>> Wczytano DelAtt>LSP. Polecenie DELA. <<") (princ) j. Cytuj
Rekomendowane odpowiedzi
Dołącz do dyskusji
Możesz dodać zawartość już teraz a zarejestrować się później. Jeśli posiadasz już konto, zaloguj się aby dodać zawartość za jego pomocą.