bloki z atrybutami


draft
 Share

Recommended Posts

przyzwyczajony do pracy z blokami, chcąc ułatwić sobie życie oraz innym postanowiłem wprowadzić do pracy z zwcadem bloki z atrybutami (niestety dynamicznych nie ma). Stworzyłem sobie blok kota wysokościowa, gdzie atrybutem jest rzędna wysokościowa. pracowałem przez jakiś czas z plikiem wszystko było pięknie ładnie, a tu gdy przychodzi czas wydruku projektu, moje bloki się posypały. Zwcad pozmieniał miejsce ustawienia rzędnej na kocie wysokościowej. Mieliście może podobne doświadczenia z blokami, w czym może być problem, co powoduje zmiany.

kotag.jpg w991.png

Link to comment
Share on other sites

  • 1 year later...
Witam wszystkich.

Czy ma ktoś jakiś przykład jak za pomocą AutoLisp-a (list i entmake) wstawić do rysunku blok z atrybutami ? Męczę się z funkcją insert ale przy duży ilościach bloków bardzo wolno wszystko chodzi.

Pozdrawiam

sprobuj tego:

(defun c:TEST (/ BLK PT)
 (if
   (and
     (setq BLK (getstring "\nPodaj nazwę bloku: "))
     (snvalid BLK)
     (not (tblsearch "BLOCK" BLK))
   )
   (if (setq PT (getpoint "\nPodaj punkt wstawienia: "))
     (progn
       (kr:BlockAttributeEntmake BLK)
       (kr:BLK_InsertBlock BLK PT 1 1 1 0)
     )
     (princ "\n>> Niepoprawny punkt. ")
   )
   (princ "\n>> Niepoprawna nazwa bloku lub blok istnieje w rysunku. ")
 )
 (princ)
)

(defun kr:BlockAttributeEntmake (Name)
 (entmake
   (list
    '(0 . "BLOCK")
    '(70 . 2)
     (cons 2 Name)
    '(10 0.0 0.0 0.0)
   )
 )
 (entmake
  '(
     (0 . "LINE")
     (8 . "0")
     (10 -0.1 0.0 0.0)
     (11 0.1 0.0 0.0)
   )
 )
 (entmake
  '(
     (0 . "LINE")
     (8 . "0")
     (10 0.0 -0.1 0.0)
     (11 0.0 0.1 0.0)
   )
 )
 (entmake
  '(
     (0 . "ATTDEF")
     (8 . "0")
     (10 0.1 0.1 0.0)
     (40 . 0.2)
     (50 . 0.0)
     (2 . "TAG")
     (3 . "Prompt")
     (1 . "Value")
   )
 )
 (entmake
  '(
     (0 . "ENDBLK")
   )
 )
)

; ============================================================ ;
; Insert block                                                 ;
;   Name   [sTR] - name                                        ;
;   InPt  [list] - insertion point (3D point)                  ;
;   X     [REAL] - X scale factor                              ;
;   Y     [REAL] - Y scale factor                              ;
;   Z     [REAL] - Z scale factor                              ;
;   Rot   [REAL] - angle of rotation in radians                ;
; ------------------------------------------------------------ ;
; (kr:BLK_InsertBlock "Cad" '(5 5 5) 10 10 10 0.75)            ;
; ============================================================ ;
(defun kr:BLK_InsertBlock (Name InPt X Y Z Rot)
 (vl-catch-all-apply
  'vla-InsertBlock
   (list
     (vla-get-modelspace
       (vla-get-activedocument
         (vlax-get-acad-object)
       )
     )
     (vlax-3d-point InPt)
     Name
     X Y Z Rot
   )
 )
)

(princ "\nPolecenie TEST. ")
(princ)

j.

Link to comment
Share on other sites

Witam ponownie.

Nadal bawię się blokami z atrybutami.

Napisałem coś takiego:

(defun c:xxx ( / )
(progn
(prompt "\nWybierz blok do zmiany jego numeru_pozycji:")
(setq da (ssget (list (cons 0 "insert" ))))
(setq ile_danych 0)
(while (< ile_danych (sslength da))
(setq da1 (ssname da ile_danych));odczyt informacji o kolejnym bloku
(setq da2 (entget(entnext da1))); przejście do kolejnego elementu bloku
(setq dane1 (cdr(assoc 0 (entget da2)))); odczyt nazwy elementu bloku (0. "ATTDEF") szukany
(prompt "\nElement: ") (princ dane1)
(setq ile_danych (+ 1 ile_danych));kolejny blok do odczytu 
);koniec while
));koniec funkcji

Procedura ma za zadanie odczytanie informacji na temat pierwszego elementu z jakiego składa się blok, wywala mi błąd na tej linii:

1)

(setq da2 (entget(entnext da1))); przejście do kolejnego elementu bloku
(setq dane1 (cdr(assoc 0 (entget da2)))); odczyt nazwy elementu bloku (0. "ATTDEF") szukany 

Natomiast jeśli wstawię coś takiego:

2)

(setq dane1 (cdr(assoc 2 (entget (entnext da1)))))

to wszystko będzie działało?

Proszę o pomoc w poprawieniu tego kodu Nr1 bo już mi brak cierpliwości.

Czym się różnią te dwa kawałki kodu że jeden chodzi a drugi nie (dla mnie oba powinny dawać te sam wyniki)?

Docelowo chciałem zrobić procedurę, która wyszukuje w blokach z atrybutami nazwę ("Tag") i jeśli znajdzie szukany atrybut zmienia jego wartość ("Value"). Wszystko pisze wyłącznie w AutoLisp-ie bo VisualLisp jak na razie dla mnie to czarna magia.

Dzięki

Link to comment
Share on other sites

Wskazówka była by nile widziana.

Pozdrawiam

wskazowka 1 - deklaruj zmienne jako lokalne aby uniknac niemilych niespodzianek przy testowaniu i uzytkowaniu progamu, wiecej tutaj:

http://kojacek.republika.pl/symbols.html

co do kodu to o jeden entget za duzo:

(defun c:xxx (/ DA ILE DA1 DA2 DANE1)
 (prompt "\nWybierz blok do zmiany jego numeru_pozycji:")
 (setq DA (ssget (list (cons 0 "insert"))))
 (setq ILE 0)
 (repeat (sslength DA)
   (setq DA1 (ssname DA ILE))
   (setq DA2 (entget (entnext DA1)))
   (setq DANE1 (cdr (assoc 0 DA2)))
   (princ (strcat "\nElement: " DANE1))
   (setq ILE (+ 1 ILE))
 )
 (princ)
)

zamiast while lepiej uzyc repeat (powtarz n razy petle)

STRCAT laczy stringi zamiast klepac iles tam princ

j.

Link to comment
Share on other sites

Witam ponownie.

Przedstawiam procedurę do zmiany wartości atrybutów w blokach.

Może to nie jest mistrzostwo ale działa. Jakby komuś było potrzebne to proszę poniżej znajduje się kod:

;funkcja główna, która  przeszukuje bloki w poszukiwaniu atrybutów o zadanej nazwie

(defun c:xxx ( / da ile_danych dane_bloki atr1)
(progn
(prompt "\nWybierz blok do zmiany jego numeru_pozycji:")
	(setq da (ssget (list (cons 0 "insert" ) ))); pobranie zbioru bloków
	(setq ile_danych 0)
			(repeat (sslength da) ;pętla zależna od ilości danych
				(setq dane_bloki (ssname da ile_danych));odczyt informacji o kolejnym bloku
					(setq atr1 (cdr(assoc 66 (entget dane_bloki)))) ;sprawdzenie czy blok posiada atrybuty
						(if (= atr1 1)(progn

							(atblok1 dane_bloki "NAZWA_SYSTEMOWA" "kr.");procedura do zmiany danych
							(atblok1 dane_bloki "MATERIAL" "C27");procedura do zmiany danych 
							(prompt "\nOdszukano bloki z atrybutami")

						));koniec testu
			(setq ile_danych (+ 1 ile_danych)));koniec reapt 
(command "_regen")
));koniec funkcji


;program do zmiany jednego atrybutu w wybranym bloku
;nazwa_bloku -  jest to zmienna okreslająca nazwę wybranego bloku delkaruje się ją poprzez (setq dane_bloki (ssname da ile_danych))  >> da - zbiór wskazanych elementów >> ile_danych - numer bloku "elementu"
;nazwa_atr - jest to nazwa "TAG" atrybutu szukanego w bloku
;wartosc_atr - jest to wartość atrybutu jaki ma być wstawiony gdy znajdzie się dany "TAG"

(defun atblok1 ( nazwa_bloku nazwa_atr wartosc_atr / da1 da2 da3 dane1 dane2 ile_d)
(progn
(setq da1 nazwa_bloku);przypisanie elementu do zmiennej
;wewnętrzna pętla przeszukująca atrybuty bloków i szukająca tagu
(setq ile_d 0)
(while (= ile_d 0)
(setq da2 (entnext da1))
(setq dane1 (cdr(assoc 0 (entget  da2))));szukanie końca bloku
	(if (= dane1 "SEQEND")
	(progn (setq ile_d 1) ))
(setq dane2 (cdr (assoc 2 (entget da2))));pobranie nazwy atrybutu
	(if (= ile_d 0) (progn ;jeżeli nie znajdzie seqend to dalej szuka i zamienia atrybuty
		(if (= dane2 nazwa_atr ) 
			(progn 
			(setq da3 (entget (entnext da1)))
			(setq da3 (subst(cons 1 wartosc_atr) (assoc 1 da3)da3)); tu nadaje sie zmiany kodu 
			(entmod da3)
	))));koniec warunków zamiany
(setq da1 (entnext da1)));koniec while
));koniec funkcji

Pozdrawiam

Link to comment
Share on other sites

Witam ponownie.

Jak za pomocą Lisp-a i funkcji entmake wstawić do rysunku blok z atrybutem?

Wiem że to temat jest ciężki ale czy da się to zrobić nie używające (command "_insert") lub vla-InsertBlock?

Wymęczyłem coś takiego jak poniżej i program wstawia mi tylko blok ale bez atrybutu:

Wstawiany blok posiada tylko jeden atrybut.

(defun C:x2 (/)
(setq dan (list 10 10 10))
(entmake(append(list
(cons 0 "INSERT") (cons 100 "AcDbEntity") (cons 67 0)
(cons 8 "0") (cons 100 "AcDbBlockReference") (cons 61 1) (cons 2 "Osie - warstwa 0")
(cons 10 dan)(cons 41 1.0) (cons 42 1.0) (cons 43 1.0) (cons 50 0.0) (cons 70 0)
(cons 71 0) (cons 44 0.0) (cons 45 0.0))))
(entmake(append(list
(cons 0 "ATTRIB") (cons 67 0)  
(cons 8 "0") (cons 284  0) (cons 48  1.00000) (cons 60  0) (cons 39  0.000000) (cons 10 dan) (cons 40  20.0000)(cons 1 "os A")
(cons 50 0.000000) (cons 41 1.00000) (cons 51 0.000000) (cons 7 "Standard") (cons 71 0) (cons 72 1) 
(cons 11 dan) (cons 210 dan )(cons 2 "OŚ") (cons 70  0) (cons 73  0) (cons 74  0) (cons 280 0))))
(entmake(append(list
(cons 0 "SEQEND") (cons 67 0) (cons 8 "0") (cons 48  1.00000) (cons 60  0))))
)

Dzięki za wszelką pomoc.

Link to comment
Share on other sites

Taki mój przykładzik na wstawianie bloków z atrybutami przez entmake

(defun d2r (degs /) (/(* pi degs)180.0))
(defun DrawLine (SP EP / OutLine LiniaDef)
(setq LiniaDef(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine")
							(cons 10 (list (car SP) (cadr SP) (caddr SP)))
							(cons 11 (list (car EP) (cadr EP) (caddr EP))))))
(if LiniaDef (setq OutLine (entlast)))
OutLine 
)


(defun DrawCoordCross ( / OutBlock Name qwe LinePion LinePoziom)
 (setq Name "Geo_Krzyz")
 (setq qwe (tblobjname "block" Name ))
 (if (null qwe)
(progn			
  (entmake (list (cons 0 "BLOCK") (cons 100 "AcDbEntity")(cons 100 "AcDbBlockBegin")
	(cons 67 0)(cons 8 "0")(cons 70 0)(cons 10 (list 0.0 0.0 0.0))(cons 2 Name)(cons 1 "")))
		(setq LinePion (DrawLine (list -4 0 0)(list 4 0 0)))		
		(setq LinePoziom (DrawLine (list 0 -4 0)(list 0 4 0)))
		;(setq XAtrib(entmake (list '(0 . "ATTDEF")(cons 100 "AcDbEntity")'(8 . "0")'(10 0.0 0.0 0.0)'(1 . "X")'(2 . "X") '(3 . "")'(40 . 1.0)'(41 . 1.0)'(50 . 0.0)'(70 . 0)'(71 . 0)'(72 . 0)'(73 . 2))))
		;(setq YAtrib(entmake (list '(0 . "ATTDEF")(cons 100 "AcDbEntity")'(8 . "0")'(10 0.0 0.0 0.0)'(1 . "Y")'(2 . "Y") '(3 . "")'(40 . 1.0)'(41 . 1.0)(cons 50 (d2r -90))'(70 . 0)'(71 . 0)'(72 . 0)'(73 . 2))))
		(entmake '((0 . "ENDBLK")))
))
OutBlock
)

(defun C:Cross ( / )
(DrawCoordCross)
(setq InsPoint (list 123.0 12 0))
(if InsPoint(progn
	(setq BlockRef(InsertBlock "Geo_Krzyz" InsPoint 1 1 1 0))
	(setq Insertion(entmake(list '(0 . "INSERT") '(100 . "AcDbEntity")'(100 . "AcDbBlockReference") 
									'(2 . "Geo_Krzyz") 
									(cons 8 "0") 
									(cons 10 InsPoint) 
									(cons 41 1) (cons 42 1) (cons 43 1) (cons 50 0) '(66 . 1) ) ))
	(entmake (list (cons 0 "ATTRIB")
	     (cons 11 InsPoint)
	     (cons 40 1)
	     (cons 1 (rtos (car InsPoint) 2 0))
	     (cons 2 "X")
	     (cons 7 (getvar "TEXTSTYLE"))
	     (cons 70 0)
	     (cons 72 0)
	     (cons 74 1)
       )
     )
     (entmake (list (cons 0 "ATTRIB")
	     (cons 11 InsPoint)
	     (cons 40 1)
	     (cons 1 (rtos (cadr InsPoint) 2 0))
	     (cons 2 "Y")
	     (cons 7 (getvar "TEXTSTYLE"))
	     (cons 70 0)
	     (cons 50 (d2r -90))
	     (cons 72 0)
	     (cons 74 1)
       )
     )
	(entmake (quote((0 ."SEQEND"))))
	(setq CrossEnt (entlast))
))
)

Link to comment
Share on other sites

Używając vla-InsertBlock jest jeszcze łatwiejsze. Wystarczy zdefiniowany blok wstawić, atrybuty wstawią się automatycznie zgodnie z wartościami domyślnymi. Atrybuty można potem pobrać bloku i edytować zgodnie z własnymi potrzebami. Np tak:

;(setq *DescBlockName* MojaNazwaBLoku)
;(setq InsPoint (list 12 15 0))

(setq DescBlock(vla-InsertBlock *Modelspace* (vlax-3d-point InsPoint ) *DescBlockName*  1 1 1 0))

Pobranie atrybutów z tego cuda:

(if (vlax-get-property DescBlock 'HasAttributes)(progn
 (setq ExAttrbs(vlax-safearray->list(vlax-variant-value(vla-getattributes DescBlock))))
))

Wycinałem to z większego fragmentu kodu, więc po prostym skopiowaniu może się nie uruchamiać, ale po podstawieniu własnych wartości pod zmienne powinno być bez problemów.

Link to comment
Share on other sites

vla-insertblock bym zrobil tak. troche bardziej uniwersalne (model, papier)

wstawia rowniez bloki nie znajdujace sie w rysunku (musza byc na sciazce)

; ============================================================ ;
; Insert block                                                 ;
;   Name   [sTR] - block name or drawing name (support path)   ;
;   InPt  [list] - insertion point (3D point)                  ;
;   X     [REAL] - X scale factor                              ;
;   Y     [REAL] - Y scale factor                              ;
;   Z     [REAL] - Z scale factor                              ;
;   Rot   [REAL] - angle of rotation in radians                ;
; ------------------------------------------------------------ ;
; (kr:BLK_InsertBlock "ldef" '(0 0 0) 1 1 1 0)                 ;
; ============================================================ ;
(defun kr:BLK_InsertBlock (Name InPt X Y Z Rot)
 (vl-catch-all-apply
  'vla-InsertBlock
   (list
     (vlax-get-property
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
       (if (= 1 (getvar 'CVPORT))
         'PaperSpace
         'ModelSpace
       )
     )
     (vlax-3d-point InPt)
     (if (tblsearch "BLOCK" Name)
       Name
       (findfile (strcat Name ".dwg"))
     )
     X Y Z Rot
   )
 )
)

j.

Link to comment
Share on other sites

Dzięki wielkie za pomoc.

Męczę te bloki, ponieważ napisałem program, który wstawia bardzo dużą ilość bloków (czasami można liczyć je w tysiącach) i przez "command" i "insert" w zwcad-dzie wstawianie ich trwa wieki (intelicadzie z InterSOFT-u troszkę szybciej).

Testowałem wstawianie takiej dużej ilości bloków bez atrybutów omawianą wyżej techniką trwa o 1/3 szybciej, więc męczarnie nad optymalizowaniem kodu raczej się opłacają.

Jak ktoś będzie chciał mieć program do odczytywania wyników obliczeń zbrojenia płyty w programie PLATO (z InterSOFT-u) to proszę pisać do mnie to udostępnię aktualną wersję napisaną w LISP-ie.

Tej mojej metody nawet InterSOFT nie znał do póki mu nie pokazałem. Dodam jeszcze, że nie jest to zgrywanie wyników w formacie DXF czy MBA zupełnie coś innego.

Kawałek funkcjonalności programu:

http://www.tomaszjankowski.webpark.pl/plato2.htm

Z optymalizacją kodu jeszcze trochę mi zejdzie bo coraz to więcej człowiek się uczy tego LISP-a, a kiedy pisałem program to dopiero raczkowałem z LISP-em.

Pozdrawiam Tomasz Jankowski

Link to comment
Share on other sites

Guest
This topic is now closed to further replies.
 Share