Assgarth

Wygląda wszystko Okey. Prawdopodobnie kwestia praw użytkownika, o czym wspomniał pawmal. Może być jeszcze kwestia ustawień firewall lub programu antywirusowego. Proszę również usunąć pliki tymczasowe z systemu (katalog TEMP). pozdrawiam

Czy może Pan udostępnić tę tabelę, którą importuje?

Dzięki uprzejmości kojacka, poniżej przedstawiam link do jego funkcji, oraz przykładowe wywołanie (sprawdziłem na Twoim rysunku "OBR_PB_ZAM_+3.dwg" i działa - ale trzeba uzbroić się w cierpliwość, bo obiektów Masz tam od groma i trochę) ;) link (defun c:SetByLayer (/ lista_z_1 lista_z_ss) (foreach blk (jk:BLK_GetBlocks nil) (setq lista_z_1 (jk:BLK_Get-DefEnt blk nil)) (foreach % lista_z_1 (cd:ENT_SetDXF % 62 256)) ) (setq lista_z_ss (zk:SSZbr->List (ssget "_x" (list (cons 0 "INSERT"))))) (foreach % lista_z_ss (foreach %1 (jk:BLK_Get-InsAtts %)(cd:ENT_SetDXF %1 62 256))) (command "_regen") ) Brakujące funkcje: ;;--------------------------------=={ jk:BLK_GetBlocks }==----------------------------------;; ;; Autor: Jacek Kożuszek, www.kojacek.republika.pl ;; ;; Funkcja zwraca liste blokow (bez xref, zaleznych od xref, anonimowych wymiarow i tabel) ;; ;; Argument [mode] jesli T - dodatkowo bloki anonimowe *U... ;; ;;------------------------------------------------------------------------------------------;; ;; (jk:BLK_GetBlocks nil) ;| lub |; (jk:BLK_GetBlocks T) ;; ;;------------------------------------------------------------------------------------------;; (defun jk:BLK_GetBlocks (mode / bl res m %) (setq m "`*D*,`*X*,`*T*,*|*" bl (tblnext "BLOCK" T) ) (while bl (setq % (cdr (assoc 2 bl))) (if (not (wcmatch % (if mode m (strcat "`*U*," m)) ) ) (setq res (append res (list %))) ) (setq bl (tblnext "BLOCK")) ) res ) oraz: (defun zk:SSZbr->List (ssZbr / % lista) (repeat (setq % (sslength ssZbr)) (setq % (1- %) lista (cons (ssname ssZbr %) lista)) ) ) Dodam tylko, że powyższe jest przeznaczone do działań na blokach. Pozostałe obiekty zostały opisane wcześniej. pozdrawiam

Jeszcze uwaga, dla ZwCAD ta linijka: (setq AtrList (vlax-safearray->list (vlax-variant-value AtrVar))) ma wyglądać tak: (setq AtrList (vlax-safearray->list AtrVar)) Assgarth

Swoją drogą te bloki są nieźle pokręcone - nie tylko ATTDEF ale i MTEXT tam mają i inne cuda niewidy :) Teoretycznie jedna z dwóch metod powinna wystarczyć - zwłaszcza funkcja "bcls", ale niestety nie w Twoim przypadku ;) Tutaj gotowy programik: link ale też nie zadziała na całości, tylko tak jak "bcls", stąd dorzuciłem Visual-Lisp'a. pozdrawiam

Sprawdziłem na jednym z bloków, które są na tym rysunku i działa, ale kod jest testowy i wymaga dopracowania - niemniej już jest bliżej niż dalej: (defun zk:SetByLayer (/ AtrVar AtrList) (setq AtrVar (vla-getAttributes (vlax-ename->vla-object (car(entsel))))) (setq AtrList (vlax-safearray->list (vlax-variant-value AtrVar))) (foreach Item AtrList (vla-put-color Item 256)) (defun bcls (block_name / block ename ent) (setq block (tblsearch "BLOCK" block_name)) (if block (progn (setq ename (cdr (assoc -2 block))) (while ename (progn (setq ent (entget ename)) (setq ent (subst (cons 62 256) (assoc 62 ent) ent)) (entmod ent) (setq ename (entnext ename)) ) ) (command "_regen") ) ) ) ;np: (bcls "SALON_A.03.07.02_778") ) blok_test.dwg

wrzuć jakiś przykładowy blok - co by nie błądzić ;)

Dla jednego bloku: (cd:ACX_SetProp (vlax-ename->vla-object (car(entsel))) '(("Color" . 256))) Dla wielu wskazanych bloków: (defun zk:SSZbr->List (ssZbr / % lista) (repeat (setq % (sslength ssZbr)) (setq % (1- %) lista (cons (ssname ssZbr %) lista)) ) ) (foreach % (zk:SSZbr->List (ssget)) (cd:ACX_SetProp (vlax-ename->vla-object %) '(("Color" . 256))) ) Dla wszystkich bloków: (foreach % (zk:SSZbr->List (ssget "_x" (list (cons 0 "INSERT")))) (cd:ACX_SetProp (vlax-ename->vla-object %) '(("Color" . 256))) ) pozdrawiam

Nie przeczę, że nie da się tego zrobić, co już wcześniej napisałem, ale musisz po pierwsze kliknąć kilka razy, a nie raz, jeśli chcesz zmienić więcej niż jedną cechę (w lisp masz jedno kliknięcie plus ewentualne wskazanie obiektów, choć i to nie jest konieczne). I tak jak napisałem w ostatnim moim poście - nie interesuje mnie do czego ktoś potrzebuje narzędzie, jeśli tylko jest ono do wykonania w miarę prosty sposób. Niemniej jednak, autor postu powinien sam zapoznać się z przedstawionymi propozycjami i wybrać najbardziej mu odpowiadającą ;) pozdrawiam

Nie wiem jakie kto ma zapotrzebowania. Osobiście nic nie projektuję, nie rysuję, ani też nie tworzę obiektów na potrzeby ich prezentacji. Działam tylko w zakresie tworzenia kodu według wytycznych, poprawiania istniejącego itp. To czy ktoś potrzebuje wrzucić wszystko na jedną warstwę, kolor itd. to jedno, a do czego tego użyje, to już nie moja sprawa :)

Zmiana samego koloru nie stanowi problemu, lecz gdy chcemy zmienić również inne parametry jak typ linii, szerokość, kolor, materiał, transparentność, styl wydruku (czyli wszystko to co ma w sobie funkcja SETBYLAYER), to już nie jest jedno kliknięcie. A jak chcemy się szybko przełączać między różnymi cechami obiektów, to Lisp umożliwi coś takiego właśnie prostym kliknięciem. Wszystko można oczywiście ręcznie sobie ustawiać itp. lecz po co, skoro można szybciej? :)

Możesz skorzystać z LISP'a. Drobna modyfikacja pod kątem ZwCADa (źródło jest na cad.pl): ;;; ======================================================================================= ;;; ;;; CADPL-Pack-v1.lsp ;;; ;;; ;;; ;;; ======================================================================================= ;;; ; =========================================================================================== ; ; Zmienia cechy obiektu VLA / Sets the property of VLA-Object ; ; Obj [VLA-Object] - obiekt / object ; ; Lst [list] - lista cech par kropkowych / list of dotted pairs properties ; ; ------------------------------------------------------------------------------------------- ; ; (cd:ACX_SetProp ; ; (vlax-ename->vla-object (entlast)) ; ; '(("LineType" . "BLA")("Color" . 1)("Layer" . "0")) ; ; ) ; ; =========================================================================================== ; (defun cd:ACX_SetProp (Obj Lst / a) (if (vlax-write-enabled-p Obj) (mapcar (function (lambda (% / %1) (cons (car %) (if (vlax-property-available-p Obj (car %)) ; iCAD ;(if (vlax-property-available-p Obj (car a) (cdr a)) ; AutoCAD (if (setq %1 (vl-catch-all-apply (quote vlax-put-property) (list Obj (car %) (cdr %)) ) ) %1 :vlax-true ) :vlax-null ) ) ) ) Lst ) ) ) ;przykładowe wywołanie (zmiana typu linii, kolor i warstwa) dla jednego wskazanego obiektu: ;(cd:ACX_SetProp (vlax-ename->vla-object (entlast)) '(("LineType" . "Continuous")("Color" . 256)("Layer" . "0"))) ; =========================================================================================== ; (princ "\n------- CADPL-Pack-v1.lsp - http://forum.cad.pl -------") (princ "\n--------------- Open Source 2011 - 2012 ---------------") (princ) Dalej, aby zadziałać na wszystkich wskazanych obiektach: ;;--------------------------------=={ zk:SSZbr->List }==-----------------------------------;; ;; Zamienia ss-grupę na listę z entity name ;; ;;-----------------------------------------------------------------------------------------;; ;; ssZbr [sSGET] - SS-group ;; ;;-----------------------------------------------------------------------------------------;; (defun zk:SSZbr->List (ssZbr / % lista) (repeat (setq % (sslength ssZbr)) (setq % (1- %) lista (cons (ssname ssZbr %) lista)) ) ) (defun c:Test () (foreach % (zk:SSZbr->List (ssget)) (cd:ACX_SetProp (vlax-ename->vla-object %) '(("LineType" . "Continuous")("Color" . 256)("Layer" . "0")("Lineweight" . "50"))) )) W przypadku ZwCAD może być konieczność regeneracji widoku obiektów - funkcja "REGEN". pozdrawiam

Proponuję jeszcze skontaktować się z przedstawicielami obu programów (choćby drogą mailową) i zadać im konkretne pytania dotyczące togo co potrzebujesz. Czasem samo opakowanie jest mylące, a wnętrze dopiero odkrywa całą prawdę ;) Ceny faktycznie są znacząco różne i w przypadku trybu "oszczędność", nie ma co się zastanawiać. W każdym innym przypadku uważam, że lepiej poświęcić jeszcze troszkę czasu i dokładnie się zorientować, który program oferuje więcej w swojej cenie i czy sprosta oczekiwaniom. Warto również zapoznać się z polityką supportu obu producentów. pozdrawiam i życzę trafnego wyboru :)

Różnic jest sporo, ale też wiele łączy oba produkty. Proponuję na początek pooglądać filmy z możliwościami obu produktów - dostępne na stronach firmowych. Jest też możliwość wypożyczenia obu programów (choć odpłatne). I zasadnicze pytanie: czy konstrukcje mają być w 2D czy 3D, bo możliwe, że żaden z tych programów nie spełnia wymagań...

No to zatem powodzenia w dalszych działaniach :) Projekt rośnie w siłę. Sprawdź przy okazji czy funkcją "_select" nie załatwiłbyś sprawy szybciej. (setq ssOld (ssget "_x")) ... jakieś działania ... (command "_select" ssOld "") (setq ssNew (ssget "_p")) Co prawda nazwa ss-grupy się zmieni, ale obiekty pozostają te same. Można ją też wykorzystać w przypadku wyłapania nowych obiektów, w stosunku do poprzedniego wyboru np. (setq ssOld (ssget "_x")) ... pojawiają się nowe obiekty ... (setq ssNew (ssget "_x")) (command "_select" ssNew "_r" ssOld "") ;wyłapanie tylko nowo powstałych obiektów (setq ssNew1 (ssget "_p")) pozdrawiam

Uhm... ciekawe. Do czego chcesz to zastosować - tak z czystej ciekawości :)

Możesz wrzucić jakiś rysunek z obiektami, na których to działa? Bo nie bardzo rozumiem (ssget "I") - czyli Implied.

Jeszcze jedna uwaga, zanim użyjesz funkcji vla-get-ActiveSelectionSet, to musisz sprawdzić czy jakiś zbiór istnieje, a jeśli nie, to go utworzyć np. (setq ss (ssget "_x" '((0 . "INSERT") (66 . 1)))) Niemniej i tak występuje błąd w tej funkcji, co też zgłosiłem w odrębnym temacie. pozdrawiam

Błąd w działaniu funkcji: vla-get-ActiveSelectionSet AC: Command: (not (zerop (vla-get-Count (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))) nil Command: _circle Specify center point for circle or [3P/2P/Ttr (tan tan radius)]: Specify radius of circle or [Diameter]: Command: (ssget "_x") Command: (not (zerop (vla-get-Count (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))) T ZW: Polecenie: (not (zerop (vla-get-Count (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))) nil Polecenie: _circle (2P) 2punkty/(3P) 3 punkty/(T) styczny(styczny styczny promień)/(A) łuk/(M) wiele/<Środek okręgu>: (D)średnica/<(R)promień>: Polecenie: (ssget "_x") Polecenie: (not (zerop (vla-get-Count (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))) błąd: *BŁĄD* (VLA-GET-ACTIVESELECTIONSET (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))) (VLA-GET-COUNT (VLA-GET-ACTIVESELECTIONSET (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))) (ZEROP (VLA-GET-COUNT (VLA-GET-ACTIVESELECTIONSET (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))))) (NOT (ZEROP (VLA-GET-COUNT (VLA-GET-ACTIVESELECTIONSET (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))))))

No właśnie się zastanawiałem dlaczego chcesz tutaj VisualLisp skoro SSGET z Lisp działa dobrze i szybciej :) Dodatkowo zauważyłem błąd w ZwCAD: przy kolejnym wywołaniu (setq adoc (vla-get-activedocument(vlax-get-acad-object)))(vlax-for a (vla-get-activeselectionset adoc)) wyrzuca błąd i to bez względu na postać funkcji. Po prostu VLA-GET-ACTIVESELECTIONSET albo nie czyści informacji w pamięci, albo wymaga dodatkowego ustawienia (w AC działa bez problemów).

hehe :) faktycznie wkleiłem Ci tą samą funkcję dwukrotnie (starą wersję i nową) - sorrki :) No ale tak czy siak, Masz już listę ename, więc utworzyć z niej z powrotem ss-group, to pikuś ;) pozdrawiam

Dwie funkcje już Masz (i w sumie tylko tyle jest Ci potrzebne): Zamienić zbiór wskazań na listę obiektów ;;--------------------------------=={ zk:SSZbr->List }==-----------------------------------;; ;; Zamienia ss-grupę na listę z entity name ;; ;;-----------------------------------------------------------------------------------------;; ;; ssZbr [sSGET] - SS-group ;; ;;-----------------------------------------------------------------------------------------;; (defun zk:SSZbr->List (ssZbr / % lista) (repeat (setq % (sslength ssZbr)) (setq % (1- %) lista (cons (ssname ssZbr %) lista)) ) ) Zamienić listę na zbior wskazań ;;--------------------------------=={ zk:LST_SS->List }==-----------------------------------;; ; Ze zbioru SS-GET tworzy listę Entity Name ;; ;;------------------------------------------------------------------------------------------;; (defun zk:LST_SS->List (sel / % l) (repeat (setq % (sslength sel)) (setq % (1- %) l (cons (ssname sel %) l) ) ) ) a potem: (sssetfirst nil ss)

Temat jeszcze aktualny? :) Bo widzę, że na cad.pl kojacek udzielił już odpowiedzi.

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

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