gruzin

Zwraca cos takiego: Command: (vlax-dump-object (vla-get-summaryinfo (vla-get-ActiveDocument (vlax-get-Acad-Object))) T) Property values: ; Author ; Comments ; HyperlinkBase ; Keywords ; LastSavedBy ; RevisionNumber ; Subject ; Title Methods supported: ; GetCustomByIndex (3) ; GetCustomByKey (2) ; NumCustomInfo () ; RemoveCustomByIndex (1) ; RemoveCustomByKey (1) ; SetCustomByIndex (3) ; SetCustomByKey (2) T

usuwania nie testowałem. dodawanie nie działa w najnowszej wersji (dodaje tylko pierszy properities i wywala błąd). W pierwszym kodzie który nadpisywał wartości wszystko działało.

pierwsza wersja: Command: (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object)))) # Command: (vla-GetCustomByIndex SI 0 'K 'V) error: *Error* (VLA-GETCUSTOMBYINDEX SI 0 (QUOTE K) (QUOTE V)) Command: (princ K) nilnil Command: (princ V) nilnil druga wersja: Command: (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object)))) # Command: (vla-GetCustomByKey SI "a" 'V2) error: *Error* (VLA-GETCUSTOMBYKEY SI "a" (QUOTE V2)) Command: (princ V2) nilnil

Działa tak jak trzeba........ ale tylko na Autocadzie w Zwcadzie wywala taki błąd: error: *Error* (VLA-GETCUSTOMBYINDEX SI (- C 1) (QUOTE K) (QUOTE V)) (WHILE (> C 0) (VLA-GETCUSTOMBYINDEX SI (- C 1) (QUOTE K) (QUOTE V)) (SETQ LST (CONS (CONS K V) LST) C (1- C))) (KR:DWG_GETCUSTOMPROPERTIES) (MAPCAR (QUOTE CAR) (KR:DWG_GETCUSTOMPROPERTIES)) (MEMBER KEY (MAPCAR (QUOTE CAR) (KR:DWG_GETCUSTOMPROPERTIES))) (IF (MEMBER KEY (MAPCAR (QUOTE CAR) (KR:DWG_GETCUSTOMPROPERTIES))) (IF MODE (VLA-SETCUSTOMBYKEY SI KEY VALUE)) (VLA-ADDCUSTOMINFO SI KEY VALUE)) (KR:DWG_ADDCUSTOMPROPERTIES (CAR ) (CADR ) nil) (FOREACH DWGPROP (KR:DWG_ADDCUSTOMPROPERTIES (CAR ) (CADR ) nil)) (C:TEST01)

Urazy do visuala nie mam. Po prostu jeszcze go nie umiem. Lispa zacząłem się uczyć chyba w listopadzie zeszłego roku a do visuala jeszcze się porządnie nie zabrałem. Jak coś się da zrobić bez visuala to robię to bez niego. W planach mam teraz opanowanie DCLa i visuala, ale robota ostatnio się nawarstwia i czasu nie ma za dużo.

oto chodziło - prawie trzeba przerobić to tylko tak aby nie nadpisywało wartości bo to bez sensu. Raz wstawiona tabelka i uzupełniona poprawnie zostaje w rysunku. Wstawiając druga tabelkę nie możemy jednocześnie tracić ustawionych DRAWING PROPERITIES. A nie da sie tego zrobić bez visual lispa? podobnie do tego: ;============================================================= (if (null (tblsearch "Layer" "IS_schemat_armatura")) (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "3" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.15" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_schemat_armatura") (command "_clayer" "IS_schemat_armatura") );progn (command "_clayer" "IS_schemat_armatura") );if ;=============================================================

W załączniku przykład tabelki która nie wstawia się poprawnie. Tabelka troche okrojona ze względu na jej właściciela (brak danych firmowych). Jak będziesz analizować kod profilka to weź poprawkę na to, że niektóre polecenia pisałem dawno i należy je gruntownie poprawić w całości, bo kod działa ale jest strasznie chaotyczny (np PKS). profilek_tabelka04.zip

Dzięki za zainteresowanie oraz kod. Z tabelkami mam inny problem niż dublowanie kodu, chociaż każde usprawnienie jest pożądane. Problem polega na tym, że chciałbym aby tabelka składała się z tekstu, atrybutów oraz pól. Z tekstem i atrybutami oczywiście nie ma problemu ale pola nie kopiują się z pliku do pliku. Jutro postaram się załączyć tabelkę którą bym chciał wstawiać poleceniem insert ale niestety są w niej pola. Jak masz jakieś ciekawe rozwiązania to ja zawsze jestem chętny do nauki, abym tylko znalazł na to czas :-)

Wyszła wersja PROFILKA 2011.01.31 Pasek z symbolami armatury już nie jest TESTOWY. Poprawiłem polecenia do schematów i teraz będę dokładał nowe. Symbole wstawione na linii rozcinają ją, wstawiane na innym obiekcie lub na pustym miejscy trzeba podać kąt obrotu. Nakładka do ściągnięcia na stronie: http://instalacjesanitarne.com/download.htm Na stronie zaktualizowałem również opis wszystkich poleceń nakładki.

Wielkie dzięki. pozdrawiam

Maksymalnie uproszczony plik lisp (defun c:rzut3prof () (setq PunktT1 (getpoint "\nKliknij pierwszy punkt: ") PunktT0 PunktT1 );setq (while PunktT1 (setq OpisT1 (getstring "\nWpisz opis do tego punktu: ")) (setq PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.") ) );while );defun rzut3prof U mnie nie da się wyjść z takiej pętli prawym przyciskiem myszy. Skasowanie linijki: (setq OpisT1 (getstring "\nWpisz opis do tego punktu: ")) naprawia błąd w Zwcadzie 2011 i pętla działa poprawnie. Czy tak powinno być? Autocad 2010 oraz Zwcad 2010 nie sprawiają takiego problemu. Oczywiście ostatnia porada z (initget 0) rozwiązuje problem, ale wydaje mi się, że powinno działać bez tego. Getstring chyba coś psuje w ustawieniach.

Załączam plik do testu. Są w nim dwie funkcje TKS (działa OK) oraz RRR, która nie działa bo getpoint nie chce przyjąć entera. W Zwcadzie 2010 działa OK, w 2011 nie działa. Obie funkcje mają pętlę while którą można (teoretycznie) zakończyć poprzez "niekliknięcie" punktu w funkcji getpoint, ale w RRR nie chce to działać i nie wiem czemu tak jest. pozdrawiam ; funkcja: RRR nie działa ; getpoint nie przyjmuje entera lub prawego przycisku myszy więc nie chce lisp wyjść z pętli while ;========================================================================= ; autor funkcji "kruszynski" z forum.projektuje.net (defun UIGetDist (msg DefVal / SelDist) (setq SelDist (vl-catch-all-apply 'getdist (list (strcat msg "<" (rtos DefVal ) ">:")))) (if (not (vl-catch-all-error-p SelDist)) (progn (if SelDist (setq OutVal SelDist ) (setq OutVal DefVal ) ) )) OutVal );defun ;========================================================================= ;========================================================================= (defun kreski (P1 P2 odsuniecie dlugosckreski / katalfa punkttemp punkttemp1 punkttemp2 styllinii grubosc) ;kreski- polecenie rysuje prostopadłe kreseczki na linii od P1 do P2 (setq styllinii (getvar "celtype") grubosc (getvar "celweight") );setq ; styl linii ustawic jako continuous (command "_celtype" "Continuous") ; grubość ustawić jako 0,15 (command "_celweight" 015) (if (> (distance P1 P2) (* 2 odsuniecie)) (progn (setq katalfa (angle P1 P2) punkttemp (polar P1 katalfa odsuniecie) punkttemp1 (polar punkttemp (- katalfa (/ pi 2)) (/ dlugosckreski 2)) punkttemp2 (polar punkttemp (+ katalfa (/ pi 2)) (/ dlugosckreski 2)) );setq (command "_line" punkttemp1 punkttemp2 "") (setq katalfa (angle P2 P1) punkttemp (polar P2 katalfa odsuniecie) punkttemp1 (polar punkttemp (- katalfa (/ pi 2)) (/ dlugosckreski 2)) punkttemp2 (polar punkttemp (+ katalfa (/ pi 2)) (/ dlugosckreski 2)) );setq (command "_line" punkttemp1 punkttemp2 "") );progn do długich kresek (progn (setq katalfa (angle P1 P2) punkttemp (polar P1 katalfa (/ (distance P1 P2) 2)) punkttemp1 (polar punkttemp (- katalfa (/ pi 2)) (/ dlugosckreski 2)) punkttemp2 (polar punkttemp (+ katalfa (/ pi 2)) (/ dlugosckreski 2)) );setq (command "_line" punkttemp1 punkttemp2 "") );progn do krótkich kresek );if (command "_celtype" styllinii "_celweight" grubosc );command );defun kreski ;========================================================================= ;========================================================================= (defun c:RRR ( / Punkt0 Punkt1 PunktT0 PunktT1 RzednaT0 RzednaT1 OpisT1 ZmianaSkalipoz ZmianaSkalipio) ;=========================================================================== ; wybieramy styl tekstu IS_SIMPLEX jako aktualny lub gdy go nie ma tworzymy go i ustawiamy jako aktualny (if (tblsearch "Style" "IS_SIMPLEX") (command "_textstyle" "IS_SIMPLEX") (progn (command "_-style" "TEMP-STYLE" "simplex.shx" "" "0.7" "" "" "" "") (command "_rename" "_S" "TEMP-STYLE" "IS_SIMPLEX") (command "_textstyle" "IS_SIMPLEX") );progn );if ;=========================================================================== ;=========================================================================== ; wybieramy warstwe IS_tabela jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_tabela") (command "_clayer" "IS_tabela") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "11" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_tabela") );progn );if ; wybieramy warstwe IS_tabela jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_teren") (command "_clayer" "IS_teren") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "61" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_teren") );progn );if ; wybieramy warstwe IS_opisy jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_opisy") (command "_clayer" "IS_opisy") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "41" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_opisy") (command "_clayer" "IS_opisy") );progn );if ;========================================================================= ;=========================================================== (setvar "dimzin" 0) ;ustawienie dokładności cyfr "pełnychg" na dokładność z przecinkami - bez tego poziom 0,0 bedzie bez przecinków podawany (setvar "osnapcoord" 1) ;zmienia sposób przyciągania do punktów, aby nie dociągało wstawianych skryptem elementów do elementów istniejących ;============================================================= ;=========================================================================== (if (null RzednaT1) (setq RzednaT1 112)) (if (null ZmianaSkalipoz) (setq ZmianaSkalipoz 1)) (if (null ZmianaSkalipio) (setq ZmianaSkalipio 1)) ;=========================================================================== (setq Punkt1 (getpoint "\nKliknij pierwszy punkt \"terenu\" od którego rysowany będzie profil (na profilu): ") ZmianaSkalipoz (UIGetDist "\nWpisz o ile razy zmienić skalę POZIOMĄ profilu w stosunku do rzutu (1 - brak zmiany, 0.2 - zmniejszenie 5x długości profilu): " ZmianaSkalipoz) ZmianaSkalipio (UIGetDist "\nWpisz o ile razy zmienić skalę PIONOWĄ profilu w stosunku do skali 1:100 (1 - brak zmiany, 2 - skala 1:50, itp): " ZmianaSkalipio) PunktT1 (getpoint "\nKliknij pierwszy punkt na rzucie.") RzednaT1 (UIGetDist "\nWpisz wartość poziomu terenu w tym punkcje: " RzednaT1) OpisT1 (getstring T "\nWpisz opis na profilu do tego punktu: ") );setq (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 pi 5) (/ pi 2) 30) "18" "90" OpisT1) (setvar "clayer" "IS_tabela") (command "_line" Punkt1 (polar Punkt1 (/ pi 2) 500) "") (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 (* 1.5 pi) (- (* (+ (rem RzednaT1 5) 5) 100) 5)) 0 10) "18" "0" (rtos (- RzednaT1 (/ (+ (rem RzednaT1 5) 5) ZmianaSkalipio)) 2 2)) (command "_circle" (polar Punkt1 (* 1.5 pi) (* (+ (rem RzednaT1 5) 5) 100)) "_d" "10") (setq PunktT0 PunktT1 PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.") );setq -------------------------------------------- (while PunktT1 (setq Punkt0 Punkt1 RzednaT0 RzednaT1 RzednaT1 (UIGetDist "\nWpisz wartość poziomu terenu w tym punkcje: " RzednaT1) OpisT1 (getstring T "\nWpisz opis na profilu do tego punktu: ") Punkt1 (polar (polar Punkt0 0 (* ZmianaSkalipoz (distance PunktT0 PunktT1))) (/ pi 2) (* ZmianaSkalipio (* (- RzednaT1 RzednaT0) 100))) );setq (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 pi 5) (/ pi 2) 50) "18" "90" OpisT1) (setvar "clayer" "IS_tabela") (command "_line" Punkt1 (polar Punkt1 (/ pi 2) 500) "") (setvar "clayer" "IS_teren") (command "_line" Punkt0 Punkt1 "") (setq PunktT0 PunktT1 PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.") );setq );while );defun RRR ;========================================================================= ;========================================================================= (defun c:TKS (/ P1 P12 P2 P3 CzyKonczyc) ;========================================================================= (command "_dimzin" "0") ;ustawienie dokładności cyfr "pełnychg" na dokładność z przecinkami - bez tego poziom 0,0 bedzie bez przecinków podawany (command "_osnapcoord" "1") ;zmienia sposób przyciągania do punktów, aby nie dociągało wstawianych skryptem elementów do elementów istniejących ;========================================================================= ;========================================================================= (if (null odsuniecie) (setq odsuniecie 14.143)) (if (null dlugosckreski) (setq dlugosckreski 12.00)) ;========================================================================= ;========================================================================= (setq odsuniecie (UIGetDist "\nPodaj odsunięcie od końca: " odsuniecie) dlugosckreski (UIGetDist "\nWpisz długość kreseczki: " dlugosckreski) );setq ;========================================================================= (setq P1 (getpoint "\nKliknij pierwszy punkt trasy kanalizacji.") P2 (getpoint P1 "\nKliknij drugi punkt trasy kanalizacji.") P3 (getpoint P2 "\nKliknij kolejny punkt trasy kanalizacji.") );setq ;========================================================================= (while P3 (if (and (> (distance P1 P2) 35) (> (distance P2 P3) 35) (or (< (abs (rem (- (angle P2 P1) (angle P2 P3)) (/ pi 2))) 0.017) (> (abs (rem (- (angle P2 P1) (angle P2 P3)) (/ pi 2))) 1.553))) (progn (setq P12 (polar P2 (angle P2 P1) 20) P2 (polar P2 (angle P2 P3) 20)) (command "_line" P1 P12 P2 "") (kreski P1 P12 odsuniecie dlugosckreski) (kreski P12 P2 odsuniecie dlugosckreski) );progn na tak (progn (command "_line" P1 P2 "") (kreski P1 P2 odsuniecie dlugosckreski) );progn na nie );if (setq P1 P2 P2 P3 P3 (getpoint P2 "\nKliknij kolejny punkt trasy kanalizacji.") );setq );while ;========================================================================= (initget 7 "Tak Nie") (setq CzyKonczyc (getkword "\nDorysować kanał do końca? :") ) (if (= CzyKonczyc "Tak") (progn (command "_line" P1 P2 "") (kreski P1 P2 odsuniecie dlugosckreski) );progn );if );defun TKS ;=========================================================================

(initget 128) pomogło, wstawiłem je dwukrotnie. (defun c:rzut2prof ( / Punkt0 Punkt1 PunktT0 PunktT1 RzednaT0 RzednaT1 OpisT1 ZmianaSkalipoz ZmianaSkalipio) ;=========================================================================== ; wybieramy styl tekstu IS_SIMPLEX jako aktualny lub gdy go nie ma tworzymy go i ustawiamy jako aktualny (if (tblsearch "Style" "IS_SIMPLEX") (command "_textstyle" "IS_SIMPLEX") (progn (command "_-style" "TEMP-STYLE" "simplex.shx" "" "0.7" "" "" "" "") (command "_rename" "_S" "TEMP-STYLE" "IS_SIMPLEX") (command "_textstyle" "IS_SIMPLEX") );progn );if ;=========================================================================== ;=========================================================================== ; wybieramy warstwe IS_tabela jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_tabela") (command "_clayer" "IS_tabela") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "11" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_tabela") );progn );if ; wybieramy warstwe IS_tabela jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_teren") (command "_clayer" "IS_teren") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "61" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_teren") );progn );if ; wybieramy warstwe IS_opisy jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_opisy") (command "_clayer" "IS_opisy") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "41" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_opisy") (command "_clayer" "IS_opisy") );progn );if ;========================================================================= ;=========================================================== (setvar "dimzin" 0) ;ustawienie dokładności cyfr "pełnychg" na dokładność z przecinkami - bez tego poziom 0,0 bedzie bez przecinków podawany (setvar "osnapcoord" 1) ;zmienia sposób przyciągania do punktów, aby nie dociągało wstawianych skryptem elementów do elementów istniejących ;============================================================= ;=========================================================================== (if (null RzednaT1) (setq RzednaT1 112)) (if (null ZmianaSkalipoz) (setq ZmianaSkalipoz 1)) (if (null ZmianaSkalipio) (setq ZmianaSkalipio 1)) ;=========================================================================== (setq Punkt1 (getpoint "\nKliknij pierwszy punkt \"terenu\" od którego rysowany będzie profil (na profilu): ") ZmianaSkalipoz (UIGetDist "\nWpisz o ile razy zmienić skalę POZIOMĄ profilu w stosunku do rzutu (1 - brak zmiany, 0.2 - zmniejszenie 5x długości profilu): " ZmianaSkalipoz) ZmianaSkalipio (UIGetDist "\nWpisz o ile razy zmienić skalę PIONOWĄ profilu w stosunku do skali 1:100 (1 - brak zmiany, 2 - skala 1:50, itp): " ZmianaSkalipio) PunktT1 (getpoint "\nKliknij pierwszy punkt na rzucie.") RzednaT1 (UIGetDist "\nWpisz wartość poziomu terenu w tym punkcje: " RzednaT1) OpisT1 (getstring T "\nWpisz opis na profilu do tego punktu: ") );setq (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 pi 5) (/ pi 2) 30) "18" "90" OpisT1) (setvar "clayer" "IS_tabela") (command "_line" Punkt1 (polar Punkt1 (/ pi 2) 500) "") (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 (* 1.5 pi) (- (* (+ (rem RzednaT1 5) 5) 100) 5)) 0 10) "18" "0" (rtos (- RzednaT1 (/ (+ (rem RzednaT1 5) 5) ZmianaSkalipio)) 2 2)) (command "_circle" (polar Punkt1 (* 1.5 pi) (* (+ (rem RzednaT1 5) 5) 100)) "_d" "10") (initget 128) (setq PunktT0 PunktT1 PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.") );setq -------------------------------------------- (while PunktT1 (setq Punkt0 Punkt1 RzednaT0 RzednaT1 RzednaT1 (UIGetDist "\nWpisz wartość poziomu terenu w tym punkcje: " RzednaT1) OpisT1 (getstring T "\nWpisz opis na profilu do tego punktu: ") Punkt1 (polar (polar Punkt0 0 (* ZmianaSkalipoz (distance PunktT0 PunktT1))) (/ pi 2) (* ZmianaSkalipio (* (- RzednaT1 RzednaT0) 100))) );setq (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 pi 5) (/ pi 2) 50) "18" "90" OpisT1) (setvar "clayer" "IS_tabela") (command "_line" Punkt1 (polar Punkt1 (/ pi 2) 500) "") (setvar "clayer" "IS_teren") (command "_line" Punkt0 Punkt1 "") (initget 128) (setq PunktT0 PunktT1) (setq PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.")) );while );defun rzut2prof Dziwi mnie tylko trochę fakt, że w ZwCadzie 2010 (oraz AutoCadzie 2010) działa bez problemu a w najnowszym ZwCad2011 nie chce działać bez (initget 128). Może to jakiś błąd w ZwCadzie? Cały plik lisp (jeszcze nie poprawiony) można sobie ściągnąć tutaj: http://instalacjesanitarne.com/download/PROFILEK.zip[/code]

mam taki kod: (defun c:rzut2prof ( / Punkt0 Punkt1 PunktT0 PunktT1 RzednaT0 RzednaT1 OpisT1 ZmianaSkalipoz ZmianaSkalipio) ;=========================================================================== ; wybieramy styl tekstu IS_SIMPLEX jako aktualny lub gdy go nie ma tworzymy go i ustawiamy jako aktualny (if (tblsearch "Style" "IS_SIMPLEX") (command "_textstyle" "IS_SIMPLEX") (progn (command "_-style" "TEMP-STYLE" "simplex.shx" "" "0.7" "" "" "" "") (command "_rename" "_S" "TEMP-STYLE" "IS_SIMPLEX") (command "_textstyle" "IS_SIMPLEX") );progn );if ;=========================================================================== ;=========================================================================== ; wybieramy warstwe IS_tabela jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_tabela") (command "_clayer" "IS_tabela") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "11" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_tabela") );progn );if ; wybieramy warstwe IS_tabela jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_teren") (command "_clayer" "IS_teren") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "61" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_teren") );progn );if ; wybieramy warstwe IS_opisy jako aktualną lub gdy jej nie ma tworzymy ją (if (tblsearch "Layer" "IS_opisy") (command "_clayer" "IS_opisy") (progn (command "_layer" "_N" "TEMP-LAYER" "_C" "41" "TEMP-LAYER" "_L" "Continuous" "TEMP-LAYER" "_LW" "0.13" "TEMP-LAYER" "") (command "_rename" "_LA" "TEMP-LAYER" "IS_opisy") (command "_clayer" "IS_opisy") );progn );if ;========================================================================= ;=========================================================== (setvar "dimzin" 0) ;ustawienie dokładności cyfr "pełnychg" na dokładność z przecinkami - bez tego poziom 0,0 bedzie bez przecinków podawany (setvar "osnapcoord" 1) ;zmienia sposób przyciągania do punktów, aby nie dociągało wstawianych skryptem elementów do elementów istniejących ;============================================================= ;=========================================================================== (if (null RzednaT1) (setq RzednaT1 112)) (if (null ZmianaSkalipoz) (setq ZmianaSkalipoz 1)) (if (null ZmianaSkalipio) (setq ZmianaSkalipio 1)) ;=========================================================================== (setq Punkt1 (getpoint "\nKliknij pierwszy punkt \"terenu\" od którego rysowany będzie profil (na profilu): ") ZmianaSkalipoz (UIGetDist "\nWpisz o ile razy zmienić skalę POZIOMĄ profilu w stosunku do rzutu (1 - brak zmiany, 0.2 - zmniejszenie 5x długości profilu): " ZmianaSkalipoz) ZmianaSkalipio (UIGetDist "\nWpisz o ile razy zmienić skalę PIONOWĄ profilu w stosunku do skali 1:100 (1 - brak zmiany, 2 - skala 1:50, itp): " ZmianaSkalipio) PunktT1 (getpoint "\nKliknij pierwszy punkt na rzucie.") RzednaT1 (UIGetDist "\nWpisz wartość poziomu terenu w tym punkcje: " RzednaT1) OpisT1 (getstring T "\nWpisz opis na profilu do tego punktu: ") );setq (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 pi 5) (/ pi 2) 30) "18" "90" OpisT1) (setvar "clayer" "IS_tabela") (command "_line" Punkt1 (polar Punkt1 (/ pi 2) 500) "") (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 (* 1.5 pi) (- (* (+ (rem RzednaT1 5) 5) 100) 5)) 0 10) "18" "0" (rtos (- RzednaT1 (/ (+ (rem RzednaT1 5) 5) ZmianaSkalipio)) 2 2)) (command "_circle" (polar Punkt1 (* 1.5 pi) (* (+ (rem RzednaT1 5) 5) 100)) "_d" "10") (setq PunktT0 PunktT1 PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.") );setq -------------------------------------------- (while PunktT1 (setq Punkt0 Punkt1 RzednaT0 RzednaT1 RzednaT1 (UIGetDist "\nWpisz wartość poziomu terenu w tym punkcje: " RzednaT1) OpisT1 (getstring T "\nWpisz opis na profilu do tego punktu: ") Punkt1 (polar (polar Punkt0 0 (* ZmianaSkalipoz (distance PunktT0 PunktT1))) (/ pi 2) (* ZmianaSkalipio (* (- RzednaT1 RzednaT0) 100))) );setq (setvar "clayer" "IS_opisy") (command "_.text" (polar (polar Punkt1 pi 5) (/ pi 2) 50) "18" "90" OpisT1) (setvar "clayer" "IS_tabela") (command "_line" Punkt1 (polar Punkt1 (/ pi 2) 500) "") (setvar "clayer" "IS_teren") (command "_line" Punkt0 Punkt1 "") (setq PunktT0 PunktT1) (setq PunktT1 (getpoint PunktT0 "\nKliknij kolejny punkt na rzucie.")) );while );defun rzut2prof Pętla while zachowuje się jakoś dziwnie pod zwcadem 2011. Polecenie getpoint nie pozwala na wciśnięcie Prawego Przycisku Myszy i wyjście z pętli. Wyświetla się komunikat: "A numeric value is needed. Please try again:" i jedynym wyjściem jest wciśnięcie ESC co niestety całkowicie przerywa funkcję. Może ktoś wie czemu getpoint nie chce przyjąć ENTERA, czy to błąd w ZWCAD2011 czy coś nie tak jest w moim lispie? Pod Academ działa prawidłowo.

Znowu dodałem kilka nowych poleceń i jest nowa wersję nakładki PROFILEK (wersja z dnia 2011.01.17) Dodałem polecenia do wstawiania przyborów sanitarnych na rozwinięciu kanalizacji sanitarnej. Niektóre przybory mają możliwość rysowania odejścia kanalizacji na kilka sposobów. Dodałem też pasek z tabelkami, które można wstawiać do rysunku jednym kliknięciem. Każdy może sobie wstawić własne tabelki do plików dwg znajdujących się wśród plików nakładki i ułatwić sobie troszkę pracę :-) Poprawiłem też kilka znalezionych błędów i usprawniłem trochę działanie programu (już nie wszystkie polecenia wyświetlają multum wiadomości podczas działania programu). W dalszych planach rozwoju są teraz polecenia do rysowania schematów. Nakładka do ściągnięcia na stronie: http://instalacjesanitarne.com/download.htm Na stronie zaktualizowałem również opis wszystkich poleceń nakładki. Paski Profilka wyglądają teraz tak (obrazki nie różnią się w stosunku do poprzednich postów bo ciągle linkuję do tego samego pliku, który uaktualniam i który jest wykorzystywany na mojej WWW): Zapraszam do ściągania i używania.

"Obiekty opisowe" hmmm Ja się cieszę, że ZwCad tego nie obsługuje, mi ta funkcja jest niepotrzebna, chociaż może niektórzy z tego korzystają. Próbowałeś otworzyć plik w którym jest np 30000 skal? W załączniku jest taki mały plik z mnóstwem skal. Zwcad otworzy go normalnie, ale skopiowanie czegokolwiek z tego pliku w autocadzie (chyba tylko 2008 i 2009) powoduje że twój plik STRASZNIE sie zamuli. Wersja Acada2010 jest już na to odporna :-) Z drugiej strony jestem ciekaw czy komuś jeszcze brakuje tej funkcji? MARCIN_ZAPYCHACZ_SKAL.zip

Z nowym rokiem oddaje nową wersję nakładki (wersja z dnia 1011.01.03) Dodałem polecenia do rysowania wewnętrznych kanalizacji sanitarnych, deszczowych i technologicznych oraz do rysowania profili podłużnych na podstawie punktów klikanych na mapie. Testowo zostawiłem pasek z poleceniami do schematów. Docelowo powinny się na nim znaleźć wszystkie podstawowe urządzenia do schematów hydraulicznych, ale chwilowo polecenia nie działają tak jak bym chciał więc trzeba jeszcze na to trochę poczekać. Nakładka do ściągnięcia na stronie: http://instalacjesanitarne.com/download.htm Na stronie zaktualizowałem również opis wszystkich poleceń nakładki.

Jest mi niezmiernie miło. Dziękuję. ID już przesłałem.

Excel, hmm? Zastanawia mnie jak dużo osób używających Zwcada używa Excela? Ja na pewno nie. Nie wydałem niepotrzebnie pieniędzy na zbyt drogiego Acada i nie kupiłem M.O. Darmowy openoffice jest wystarczająco dobry pod warunkiem, że umie się go używać. Zastanawiam się więc dlaczego Zwcad importuje tabele tylko z Excela, a z Calca już nie (nie sprawdzałem czy tak jest, zakładam że krzysztoff pisze prawdę).

Chyba pojawiła się wersja stabilna 2011 ?? Przynajmniej tak są opisane katalogi na serwerach ftp. ftp://download.zwcad.org/en/2011MsiInstaller/2011Official/

Do elektryki jest coś takiego: http://www.cadprofi.com/pl/index.php?option=com_content&task=view&id=29&Itemid=36 Nie jestem elektrykiem i nie wiem na ile jest to przydatne. Można ściągnąć demo i samemu się przekonać.

Jest kolejna wersja nakładki (z dnia 2010.11.22). Dodałem na nowym pasku polecenia do tworzenia warstw oraz wyeliminowałem zgłoszone niedogodności. Napisałem licencję (pod ikonką ze znakiem zapytania) aby nie było niejasności, że program jest darmowy. Nakładka do ściągnięcia na stronie: http://instalacjesanitarne.com/download.htm Na stronie jest również instrukcja instalacji dla mniej zaawansowanych użytkowników pozdrawiam i zapraszam do ściągania i używania

Nie wiem jak inni ale ja jestem zainteresowany VBA.

potwierdzam błędy. Dodam że podświetlanie zmienia kolejność (draw order) nie tylko wypełnień ale również innych elementów np linie (jak są grube i mają różny kolor to widać zmiany).

wszystkie rury i izolacja rysowane są liniami (elementy nie są zgrupowane w żaden sposóB). Jak chcesz wydłużać narysowane rury to polecam funkcję "_stretch" "rozciągnij" (ikonka między "utnij" i "skala". p.s. Na stronie jest nowsza wersja nakładki (obraca wszystkie kolana, może rysować na każdym izolację, zapamiętuje wybrane średnice i grubości izolacji) pozdrawiam