vla-addtext - niewidoczny nowy tekst

gruzin · 8 Stycznia 2012

Piszę program który w pewnym momencie wpisuje na modelu "text". Problem jest w tym że Zwcad nie wyswietla wstawionego tekstu dopuki nie odświezy sie rzutni (regen).

Czy jest na to jakas rada? Jakieś odświeżenie tylko nowego textu, albo sposób na to aby byl od razu widoczny?

Linie wstawiane podobnym sposobem wyświetlają sie od razu po wstawieniu.

(vla-AddLine mh_model_space (vlax-3d-point p1) (vlax-3d-point p2))
;ta linia jest widoczna od razu

(defun mh:PiszText ( / PunktTextu newtext )
(setq	PunktTextu (polar WSKAZ_PUNKT (* pi 0.25) (* WysZnacznika 0.7))
       newtext (vla-AddText mh_model_space (itoa Numer) (vlax-3d-point PunktTextu) WysText))
);defun

;ten tekst widoczny dopiero po odświeżeniu rzutni

Assgarth · 9 Stycznia 2012

Prawdopodobnie jest to błąd w ZwCAD. Sprawdziłem pod AC i tam nie ma konieczności odświeżania obiektów, rzutni itp.

Dla Twoich potrzeb dodaj na koniec:

(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)

lub

(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)

to w zupełności rozwiązuje problem (choć nie jest rozwiązaniem błędu ZW).

pozdrawiam

gruzin · 9 Stycznia 2012

Tak, regen rozwiązuje problem, ale tylko częściowo.

Funkcja rysuje po kliknięciu w kolejne punkty krzyżyk w tych punktach oraz "tekstem" wpisuje numer tego punktu (którego nie widać dopóki nie zrobi się regen). Jednocześnie do pliku tekstowego zapisywane są współrzędne punktów.

Wywołanie regen na końcu nie spowoduje że w trakcie działania funkcji będą pojawiały sie teksty na ekranie, a regen po klknięciu kazdego punktu odpada.

Chyba w tym przypadku zostanę przy tradycyjnym "command".

Assgarth · 9 Stycznia 2012

Może taki trick byłby wystarczający:

(command "_move" (entlast) "" "" "")

W ten sposób nie odświeżasz całego rysunku, a jedynie symulujesz operację przesunięcia obiektu. Nic się w sumie nie dzieje, a Twój obiekt zaczyna być widoczny na rysunku...

No i jeszcze lepszy sposób to:

(entupd (entlast))

pozdrawiam

gruzin · 9 Stycznia 2012

(entupd (entlast))

to jest dobre :-)

dzięki za podpowiedź

gruzin · 9 Stycznia 2012

Jakby ktoś chciał to cała procedura do przetestowania poniżej:

(defun c:mh_xyz( / mh_CadObj mh_acd_doc mh_model_space mh_textstyles newtextstyle mh_LayerTable newlayer WSKAZ_PUNKT PrefixPunktu WSPÓŁRZEDNA_Y WSPÓŁRZEDNA_X LINIA Numer NazwaPlikuTxt ZnacznikPunktu WysZnacznika PlikTxt WysText)
;(mh:ustzap)

;=========================================================================
; PODFUNKCJE 
			(defun mh:PiszText ( / PunktTextu newtext )
				(setq	PunktTextu (polar WSKAZ_PUNKT (* pi 0.25) (* WysZnacznika 0.7)))
				(vla-AddText mh_model_space (strcat PrefixPunktu "-" (itoa Numer)) (vlax-3d-point PunktTextu) WysText)
				(entupd (entlast))	;odświeżenie teksty, żeby był widoczny (to błąd zwcada, w AC jest widoczny od razu)
			);defun

			(defun mh:RysujPunkt (/ p1 p2 p3 p4)
				(setq	p1	(polar WSKAZ_PUNKT (* pi 0.5) WysZnacznika)
						p2	(polar WSKAZ_PUNKT (* pi 1.5) WysZnacznika)
						p3	(polar WSKAZ_PUNKT 0.0 WysZnacznika)
						p4	(polar WSKAZ_PUNKT pi WysZnacznika)
				)
				(vla-AddLine mh_model_space (vlax-3d-point p1) (vlax-3d-point p2))
				(vla-AddLine mh_model_space (vlax-3d-point p3) (vlax-3d-point p4))
			);defun
;=========================================================================


;=============================================================
(vl-load-com)
(setq	mh_CadObj		(vlax-get-acad-object)
	mh_acd_doc		(vla-get-activedocument mh_CadObj)
	mh_model_space	(vla-get-ModelSpace mh_acd_doc)
)

;=============================================================
(setq mh_textstyles (vla-get-textstyles mh_acd_doc))
;=============================================================
(if (null (tblsearch "Style" "IS_SIMPLEX")) 
(progn
	(setq newtextstyle (vla-add mh_textstyles "IS_SIMPLEX"))
	(vla-put-fontfile newtextstyle "simplex.shx")
	(vla-put-width newtextstyle 0.7)
);progn
);if
(vla-put-activetextstyle mh_acd_doc newtextstyle)
;=============================================================

;=============================================================
(setq mh_LayerTable (vla-get-layers mh_acd_doc))
;=============================================================
(if (null (tblsearch "Layer" "IS_Opis_Znaczników"))
(progn
	(setq newlayer (vla-add mh_LayerTable "IS_Opis_Znaczników"))
	(vla-put-Color newlayer 41)
	(vla-put-LineType newlayer "Continuous")
	(vla-put-LineWeight newlayer 13)
)
);if
(vla-put-activeLayer mh_acd_doc newlayer)
;=============================================================


   (initget (+ 1 2 4))
   (setq Numer (getint "\nPodaj numer pierwszego punktu:"))
   (setq	WysText			90.0																		;wysokosc tekstu =90
		PrefixPunktu	(mh:GetChoisText "\Wybierz prefix punktu" '("S" "D" "SC" "G" "W") "S") 
		WysZnacznika	(* WysText 1.1)																; wielkość krzyża 
		NazwaPlikuTxt	(getfiled "Wpisz nazwe pliku z współrzędnymi punktów" "" "txt" 1)
		ZnacznikPunktu	(mh:GetChoisText "\Czy wstawiać znacznik punktu?" '("Tak" "Nie") "Tak")
		PlikTxt			(open NazwaPlikuTxt "W"))

   (WRITE-line (strcat "Nr" ";" "X" ";" "Y" ) PlikTxt)
   (while	(setq WSKAZ_PUNKT (getpoint "\nWskaz punkt"))
		(setq	WSPÓŁRZEDNA_Y	(rtos (cadr WSKAZ_PUNKT) 2 2)
				WSPÓŁRZEDNA_X	(rtos (car WSKAZ_PUNKT) 2 2)
				LINIA			(strcat PrefixPunktu "-" (itoa Numer) ";" WSPÓŁRZEDNA_X ";" WSPÓŁRZEDNA_Y )
		)
		(WRITE-line LINIA PlikTxt)

		(if (= ZnacznikPunktu "Tak")
			(progn
				(mh:RysujPunkt)
				(mh:PiszText)
			)
			(mh:PiszText)
		)

		(setq Numer (1+ Numer))
);WHILE

   (close PlikTxt)


;(mh:ustprzywr)
);defun

(defun mh:GetChoisText (msg opcje DefVal / msg2 msg3 SelDist OutVal)
;=========================================================================
; msg = tekst zapytania
; opcje = LISTA tekstów możliwych do wyboru
; DefVal = wartość TEKSTU wybierana domyślnie
; example: (mh:GetChoisText "\nPodaj wartosc?" '("aaa" "bbb" "ccc" "ddd" "eee") "ddd")
;=========================================================================

	(setq msg2 "")
	(foreach % opcje
	(setq msg2 (strcat msg2 % " "))
	);foreach
	(setq msg2 (substr msg2 1 (- (strlen msg2) 1))) ;usunięcie oststniej spacji

	(setq msg3 "")
	(foreach % opcje
	(setq msg3 (strcat msg3 % "/"))
	);foreach
	(setq msg3 (substr msg3 1 (- (strlen msg3) 1))) ;usunięcie oststniego ukośnika "/"

(initget 0 msg2)
(setq SelDist (vl-catch-all-apply 'getkword (list (strcat msg " [" msg3 "] <"  DefVal ">: "))))

 (if (not (vl-catch-all-error-p SelDist))
	(progn
		(if SelDist
			(setq OutVal SelDist)
			(setq OutVal DefVal)
		);if
	);progn
 );if
OutVal
);defun mh:GetChoisText

Assgarth · 9 Stycznia 2012

Działa raczej poprawnie, ale... tylko przy pierwszym uruchomieniu.

Za drugim razem jest błąd, a dokładnie w tym miejscu:

(if (null (tblsearch "Style" "IS_SIMPLEX")) 
   (progn 
       (setq newtextstyle (vla-add mh_textstyles "IS_SIMPLEX")) 
       (vla-put-fontfile newtextstyle "simplex.shx") 
       (vla-put-width newtextstyle 0.7) 
   );progn 
);if 
(vla-put-activetextstyle mh_acd_doc newtextstyle)

Brakuje akcji gdy styl został znaleziony, gdyż wówczas zmienna "newtextstyle" nieistnieje...

albo ustawisz ją jako globalną, albo po prostu przypisz jej wartość Twojego stylu.

pozdrawiam

Assgarth · 9 Stycznia 2012

To samo jest przy ustalaniu warstwy: "newlayer".

Lub po prostu ustaw w ten sposób:

(if (null (tblsearch "Style" "IS_SIMPLEX")) 
   (progn 
       (setq newtextstyle (vla-add mh_textstyles "IS_SIMPLEX")) 
       (vla-put-fontfile newtextstyle "simplex.shx") 
       (vla-put-width newtextstyle 0.7) 
	(vla-put-activetextstyle mh_acd_doc newtextstyle)
   );progn 
);if 

;============================================================= 

;============================================================= 
(setq mh_LayerTable (vla-get-layers mh_acd_doc)) 
;============================================================= 
(if (null (tblsearch "Layer" "IS_Opis_Znaczników")) 
   (progn 
       (setq newlayer (vla-add mh_LayerTable "IS_Opis_Znaczników")) 
       (vla-put-Color newlayer 41) 
       (vla-put-LineType newlayer "Continuous") 
       (vla-put-LineWeight newlayer 13) 
	(vla-put-activeLayer mh_acd_doc newlayer) 
   ) 
);if

pozdrawiam,

Assgarth

gruzin · 9 Stycznia 2012

dziękli za uwagi

zmieniłem trochę inaczej:

;=============================================================
(setq mh_textstyles (vla-get-textstyles mh_acd_doc))
;=============================================================
(if (null (tblsearch "Style" "IS_SIMPLEX")) 
(progn
	(setq newtextstyle (vla-add mh_textstyles "IS_SIMPLEX"))
	(vla-put-fontfile newtextstyle "simplex.shx")
	(vla-put-width newtextstyle 0.7)
);progn
(setq newtextstyle (vla-item mh_textstyles "IS_SIMPLEX"))
);if
(vla-put-activetextstyle mh_acd_doc newtextstyle)
;=============================================================

;=============================================================
(setq mh_LayerTable (vla-get-layers mh_acd_doc))
;=============================================================
(if (null (tblsearch "Layer" "IS_Opis_Znaczników"))
(progn
	(setq newlayer (vla-add mh_LayerTable "IS_Opis_Znaczników"))
	(vla-put-Color newlayer 41)
	(vla-put-LineType newlayer "Continuous")
	(vla-put-LineWeight newlayer 13)
)
(setq newlayer (vla-item mh_LayerTable "IS_Opis_Znaczników"))
);if
(vla-put-activeLayer mh_acd_doc newlayer)
;=============================================================

Assgarth · 9 Stycznia 2012

Tak aby było jeszcze lepiej, proponuję dorzucić pewne zabezpieczenie na wypadek, gdy użytkownik nie poda nazwy pliku:

(initget (+ 1 2 4)) 
   (setq Numer          (getint "\nPodaj numer pierwszego punktu:")) 
   (setq WysText         90.0                            ;wysokosc tekstu =90 
         PrefixPunktu    (mh:GetChoisText "\Wybierz prefix punktu" '("S" "D" "SC" "G" "W") "S") 
         WysZnacznika    (* WysText 1.1)          ; wielkość krzyża 
	  ZnacznikPunktu  (mh:GetChoisText "\Czy wstawiać znacznik punktu?" '("Tak" "Nie") "Tak"))
(while (not NazwaPlikuTxt)
	(setq NazwaPlikuTxt   (getfiled "Wpisz nazwe pliku z współrzędnymi punktów" "" "txt" 1))
)
(setq PlikTxt (open NazwaPlikuTxt "W"))

ewentualnie może po prostu wyjść z procedury lub dodać warunek, że jeśli nie podasz nazwy pliku, to wówczas wstawiasz punkty na rysunku, bez zapisu do pliku zewnętrznego.

Można też umożliwić numerację od "0":

(initget (+ 1 4))

A tak to jeszcze jakaś bardziej rozbudowana obsługa błędów i gotowe :)

pozdrawiam

Assgarth · 9 Stycznia 2012

Taka sugestia, że jeśli Będziesz chciał rozbudować swoją funkcję o obsługę błędów, to zwróć uwagę przede wszystkim na to, że jeśli użytkownik przerwie polecenie wstawiania kolejnych punktów przyciskiem Esc, wówczas nie ma możliwości usunięcia pliku, do którego zapisywały się współrzędne.

Plik jest cały czas w użyciu (nie został zamknięty).

Tutaj moja propozycja:

;;------------------------------=={ zk:ERR_ErrorHandling }==-------------------------------;;
;;  Error handling                                                                         ;;
;;-----------------------------------------------------------------------------------------;;
;;  Msg  [sTR] - error message                                                             ;;
;;-----------------------------------------------------------------------------------------;;
(defun zk:ERR_ErrorHandling (Msg)
(if 
	(= 8 (logand 8 (getvar "UNDOCTL")))
	(zk:SYS_EndUndo)
)
(if
	(or
		(= Msg "Function cancelled")
		(= Msg "quit / exit abort")
		(= Msg "funkcja anulowana")					;specjalnie dla ZwCAD
	)
	(progn
		(princ "\n-----------------------------------------------------------------")
		(princ (strcat "\nOpis błędu: " Msg ))
		(princ (strcat "\nNumer błędu: " (itoa (getvar "ERRNO"))))
		;(command "_undo" "")						;to opcjonalnie
		(close PlikTxt)								;zamknięcie pliku
		(terpri)
	)
)
(if *ERR (setq *error* *ERR))
)

(defun zk:ACX_ADoc ()
(vl-load-com)
(or
	*zk-ADoc
		(setq *zk-ADoc (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
)
*zk-ADoc
)

;;--------------------------------=={ zk:SYS_StartUndo }==---------------------------------;;
;; Start undo mark                                                                         ;;
;;-----------------------------------------------------------------------------------------;;
(defun zk:SYS_StartUndo () 
(command "_undo" "_be")					;ZwCAD
;(vla-StartUndoMark (zk:ACX_ADoc))		;AutoCAD
)

;;--------------------------------=={ zk:SYS_EndUndo }==-----------------------------------;;
;; End undo mark                                                                           ;;
;;-----------------------------------------------------------------------------------------;;
(defun zk:SYS_EndUndo () 
(command "_undo" "_e")					;ZwCAD
;(vla-EndUndoMark (zk:ACX_ADoc))		;AutoCAD
)

dodać tutaj:

(setq *ERR *error* *error* zk:ERR_ErrorHandling)
(zk:SYS_StartUndo)

(setq   mh_CadObj         (vlax-get-acad-object) 
       mh_acd_doc        (vla-get-activedocument mh_CadObj) 
       mh_model_space    (vla-get-ModelSpace mh_acd_doc) 
)

i tutaj:

(close PlikTxt) 
(zk:SYS_EndUndo)

Wówczas jest okey. W powyższym przypadku zmienna "PlikTxt" musi być globalna.

Możesz oczywiście włączyć tę obsługę do funkcji lokalnej i wówczas zmienna "PlikTxt" będzie lokalna (czyli tak jak było). Poniżej całość:

;========================================================================= 
; PODFUNKCJE 
               (defun mh:PiszText ( / PunktTextu newtext ) 
                   (setq    PunktTextu (polar WSKAZ_PUNKT (* pi 0.25) (* WysZnacznika 0.7))) 
                   (vla-AddText mh_model_space (strcat PrefixPunktu "-" (itoa Numer)) (vlax-3d-point PunktTextu) WysText) 
                   (entupd (entlast))    ;odświeżenie teksty, żeby był widoczny (to błąd zwcada, w AC jest widoczny od razu) 
               );defun 

               (defun mh:RysujPunkt (/ p1 p2 p3 p4) 
                   (setq   p1    (polar WSKAZ_PUNKT (* pi 0.5) WysZnacznika) 
                           p2    (polar WSKAZ_PUNKT (* pi 1.5) WysZnacznika) 
                           p3    (polar WSKAZ_PUNKT 0.0 WysZnacznika) 
                           p4    (polar WSKAZ_PUNKT pi WysZnacznika) 
                   ) 
                   (vla-AddLine mh_model_space (vlax-3d-point p1) (vlax-3d-point p2)) 
                   (vla-AddLine mh_model_space (vlax-3d-point p3) (vlax-3d-point p4)) 
               );defun 

			(defun zk:ERR_ErrorHandling (Msg)
				(if 
					(= 8 (logand 8 (getvar "UNDOCTL")))
					(zk:SYS_EndUndo)
				)
				(if
					(or
						(= Msg "Function cancelled")
						(= Msg "quit / exit abort")
						(= Msg "funkcja anulowana")					;specjalnie dla ZwCAD
					)
					(progn
						(princ "\n-----------------------------------------------------------------")
						(princ (strcat "\nOpis błędu: " Msg ))
						(princ (strcat "\nNumer błędu: " (itoa (getvar "ERRNO"))))
						;(command "_undo" "")						;to opcjonalnie
						(close PlikTxt)								;zamknięcie pliku
						(terpri)
					)
				)
				(if *ERR (setq *error* *ERR))
			)
;=========================================================================

Do wyboru, do koloru ;)

pozdrawiam

gruzin · 9 Stycznia 2012

Start udno i endundo mam w funkcjach :

(mh:ustzap)

(mh:ustprzywr)

tutaj jako komentarz

z zamknięciem pliku i ESC coś jeszcze podumam.

Zaloguj się

vla-addtext - niewidoczny nowy tekst

Rekomendowane odpowiedzi

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Odnośnik do komentarza

Udostępnij na innych stronach

Dołącz do dyskusji