Jason

slide wypelniasz z lispa. ponizszy kod z kursy zwcad\lisp\dcl 1. (defun DCL_WriteToImage (slide Key / War width height) 2. (setq width (dimx_tile Key)) 3. (setq height (dimy_tile Key)) 4. (start_image Key) 5. (fill_image 0 0 width height 0) 6. (slide_image 0 0 width height slide) 7. (end_image) 8. ) jason

oczywiscie ze atoi powinno byc, maly babol sie wkradl :grin: (setq L (list "a" "b" "c" "d")) najkrocej (vl-position "b" L) bez vl: (setq C 0) (foreach % L (if (= "b" %) (setq P C) ) (setq C (1+ C)) ) (princ P) atof nie moze byc gdyz nth nie przyjmuje real (nth 1.0 (list "a" "b")) -> bad argument (nth 1 (list "a" "b")) -> "b" j.

jakiegos szalenstwa nie ma. wiekszosc wycinkow opeira sie na tym samym. - wypelnianie wycinka (start_list "TU NAZWA WYCINKA") (mapcar 'add_list TUTUAJLISTA) (end_list) - i obsluga (action_tile "POPUP" "(setq POS $value)") - zwraca numer pozycjii jako string "0" "1" itd (action_tile "POPUP" "(setq POS (nth $value LISTA))") - zwraca wartosc z pozycji jako string "cos na pozycji 0" "cos na pozycji 0" itd j.

POP_UP_10 to zdefiniowana pod_funkcja. jesli cos sie powtarza kilka razy w tym samym wycinku to mozna to zgrupowac. w moim wypadku jest edit_width = 20. zamiast zmieniac wartosc 20 w 5 miejscach robisz tylko podmiane w jedym. POP_UP_10 : popup_list { edit_width = 20; } jesli gdzies to chcesz uzyc to robisz: : POP_UP_10 { list = "S" ; label = "Oznaczenie węzłów:"; } i jest to pop_up z list, label i pobiera edit_width z POP_UP_10 chyba nie zamieszalem. w zalaczniku pliczek jak mozna wykorzystywac pod_funkcje (zmien rozsz. z zip na dcl bo chyba nie mozna dodawac dcl) j. Atx.zip

widze ze dochodza kolejne okienka, fajne :) te radio sprawiaja ze okno jest troche rozlazle (moim zdaniem) moze jakby jakos tak zakombinowac: //// MAIN //// profil : dialog { label = "Opisywanie profili podłużnych"; : boxed_column { label = "Dane:"; : EDIT_BOX_10 { key = "DCL_POZIOM"; label = "Wpisz wartość poziomu por. [m]: "; } : EDIT_BOX_10 { key = "DCL_odl0"; label = "Odległość dla punktu \"0\" [m]: "; } : EDIT_BOX_10 { key = "DCL_srednica"; label = "Średnica rurociągu [mm]: "; } : EDIT_BOX_10 { key = "DCL_skalapoziom"; label = "Skala pozioma <1:xxx>: "; } : EDIT_BOX_10 { key = "DCL_skalapion"; label = "Skala pionowa <1:yyy>: "; } : EDIT_BOX_10 { key = "DCL_nrwezla"; label = "Numer pierwszego węzła: "; } spacer; } : boxed_column { label = "Ustawienia:"; : POP_UP_10 { label = "Opisywanie kolizji:"; list = "Opisywanie kolizji"; } : POP_UP_10 { list = "Rysuj metrykę tabeli:" ; label = "Metryka tabelki"; } : POP_UP_10 { list = "Spód" ; label = "Sposób rysowania sieci:"; } : POP_UP_10 { list = "PVC" ; label = "Materiał rurociągu:"; } : POP_UP_10 { list = "S" ; label = "Oznaczenie węzłów:"; } spacer; } ok_cancel; } //// SUB //// EDIT_BOX_10 : edit_box { edit_limit = 10; edit_width = 10; } POP_UP_10 : popup_list { edit_width = 20; }

a tu jeszcze swietny material do DCL http://web2.airmail.net/terrycad/Tutorials/MyDialogs.htm j.

rzucilem sobie znowu okiem na twoj PROFILEk (metrix). pare zmian w kodzie plus zapamietanie ostatnich pozycji w okienku. kod ponizej jesli zainteresowany: (defun C:METRIX_GAZ (/ DCL ACT NAZWA WIDOK PT) (setq DCL (load_dialog "profilek-gaz.dcl")) (if (not (new_dialog "metrixgaz" DCL)) (alert "Nie znaleziono pliku profilek-gaz.dcl") (progn (if (not *metrix_gaz*) (setq *metrix_gaz* (list "gazomierz_1" "front")) ) (setq NAZWA (car *metrix_gaz*) WIDOK (last *metrix_gaz*) ) (foreach % (list "NAZWA" "WIDOK") (set_tile % (eval (read %))) (action_tile % (strcat "(setq " % " $value)")) ) (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ACT (start_dialog)) (unload_dialog DCL) (if (zerop ACT) (princ "\nAnulowano. ") (progn (if (setq PT (getpoint "\nPodaj punkt wstawienia gazomierza: ")) (progn (kr:BLK_InsertBlock PT (strcat "Profilek-metrix_" NAZWA "_" WIDOK) 1 1 1 0 ) (setq *metrix_gaz* (list NAZWA WIDOK)) ) (princ "\nNiepoprawny punkt. ") ) ) ) ) ) (princ) ) ; ============================================================ ; ; Insert block ; ; InPt [list] - insertion point (3D point) ; ; Name [sTR] - block name or drawing name (support path) ; ; 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 '(0 0 0) "ldef" 1 1 1 0) ; ; ============================================================ ; (defun kr:BLK_InsertBlock (InPt Name 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 ) ) ) metrixgaz : dialog { label = "Gazomierze METRIX"; :boxed_radio_column { key = "NAZWA"; label = "Gazomierz" ; : radio_button { key = "gazomierz_1" ; label = "Gazomierz - UG (G1,6 G2,5 G4)" ; } :radio_button { key = "gazomierz_2" ; label = "Gazomierz - 6G4, 6G6" ; } :radio_button { key = "gazomierz_3" ; label = "Gazomierz - 6G4-250" ; } :radio_button { key = "gazomierz_4" ; label = "Gazomierz - G10" ; } :radio_button { key = "gazomierz_5" ; label = "Gazomierz - G16, G25" ; } :radio_button { key = "gazomierz_6" ; label = "Gazomierz - G40, G65" ; } } : boxed_radio_column { label = "Widok" ; key = "WIDOK"; : radio_button { key = "front" ; label = "Widok z przodu" ; } :radio_button { key = "bok" ; label = "Widok z boku" ; } } ok_cancel; } jakies pytania, wal smialo j.

_SUBTRACT j.

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.

fakt, potwierdzam. wyglada to troche smiesznie j.

czyli metoda GetCustomByIndex jest ostatnia proba i sie poddaje (utworz tylko jeden properties): (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object)))) (vlax-invoke-method SI 'GetCustomByIndex 0 'K 'V) (princ K) jaki zwcad, ktora wersja? jak nie zahula to moze to jakis blad. a moze ma jeszcze ktos jakis pomysl? j.

to nam powinno wszytko wyjasnic: (vlax-dump-object (vla-get-summaryinfo (vla-get-ActiveDocument (vlax-get-Acad-Object))) T) co zwraca? j.

to lekka kup. a czy dodawanie i usuwanie dziala? j.

wstukaj po kolei dwa ponizsze sposoby i powiedz co zwraca kazda linijka stworz wczesniej tylko jedno properties o nazwie a 1. (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object)))) (vla-GetCustomByIndex SI 0 'K 'V) (princ K) (princ V) 2. (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object)))) (vla-GetCustomByKey SI "a" 'V2) (princ V2) j.

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.

chcesz wskazowki (mozna sie czegos nauczyc) czy gotowe rozwiazanie (tez sie czlowiek nauczy o ile bedzie chcial zrozumiec gotowy kod)? j.

(defun C:TEST (/ DWGPROP) (vl-load-com) (setq DWGPROP (list '("PROFILEK_EDYCJA" "A") '("PROFILEK_DATA" "2011") '("PROFILEK_OBIEKT" "") ) ) (foreach % DWGPROP (kr:DWG_AddCustomProperties (car %) (cadr %) nil) ) (princ) ) ; ============================================================ ; ; Add drawing custom properties ; ; Key [sTR] - custom properties name ; ; Value [sTR] - custom properties value ; ; Mode [bOOL] - nil = do not update existing key ; ; T = update existing key ; ; ============================================================ ; (defun kr:DWG_AddCustomProperties (Key Value Mode / SI) (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) (if (member Key (mapcar 'car (kr:DWG_GetCustomProperties))) (if Mode (vla-SetCustomByKey SI Key Value)) (vla-AddCustomInfo SI Key Value) ) ) ; ============================================================ ; ; Get drawing custom properties ; ; ============================================================ ; (defun kr:DWG_GetCustomProperties (/ SI C K V LST) (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object) ) ) C (vla-NumCustomInfo SI) ) (while (> C 0) (vla-GetCustomByIndex SI (- C 1) 'K 'V) (setq LST (cons (cons K V) LST) C (1- C) ) ) LST ) ; ============================================================ ; ; Remove drawing custom properties ; ; Mode - list of custom properties name to remove ; ; T = remove all ; ; ============================================================ ; (defun kr:DWG_RemoveCustomProperties (Mode / SI) (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) (if (listp Mode) (foreach % Mode (vl-catch-all-apply 'vla-RemoveCustomByKey (list SI %) ) ) (foreach % (mapcar 'car (kr:DWG_GetCustomProperties)) (vla-RemoveCustomByKey SI %) ) ) ) jesli chcesz to korzystaj: dodawanie (nadpisuje jesli chcemy), odczytywanie i usuwanie PROPERTIES. niestety visual. inaczej sie nie da. za wiele nie testowalem ale z grubsza powinno dzialac. j.

tak samo zaczynalem. command chyba masz opanowane wiec zastartowalbym do visuala. wierz mi ze po pewnym czasie nie bedziesz chcial wrocic z kolei do command :) j.

z nadpisywaniem masz racje. na razie chcialem aby cos dzialalo. niestety bez visuala chyba nie ma szans. nie ma dostepu do pewnych rzeczy. jakas uraza do visuala? czemu chcesz command? j.

sprobuj tego: (defun C:TEST (/ DWGPROP) (vl-load-com) (setq DWGPROP (list '("PROFILEK_EDYCJA" "A") '("PROFILEK_DATA" "2011") '("PROFILEK_OBIEKT" "") ) ) (foreach % DWGPROP (kr:DWG_AddCustomProperties (car %) (cadr %)) ) (princ) ) ; ============================================================ ; ; Add drawing custom properties ; ; Name [sTR] - custom properties name ; ; Value [sTR] - custom properties value ; ; ============================================================ ; (defun kr:DWG_AddCustomProperties (Name Value / SI) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetCustomByKey (list (setq SI (vla-get-SummaryInfo (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) Name Value ) ) ) (vla-AddCustomInfo SI Name Value) ) ) tworzy w rysunku PROPERTIES jesli ich nie ma. Jesli sa jakies wartosci to je nadpisuje j.

haha, FILED'y :grin: widze w czym problem. aby ci to zadzialalo musisz wczesniej utworzyc w rysunku wszyskie DRAWING PROPERTIES ktore masz w bazowym rysunku. gdzies mialem taka funkcje jak znajda to podrzuce co do kodu to fakt. lekki chaos. ciezko sie odnalesc j.

nie do konca rozumie w czym problem. podrzucisz plik to sie zobaczy. to tak jak ja. zobacze co by mozna jeszcze jakos skrocic/polepszyc/przyspieszyc itp. j.

male usprawnienie jesli chcesz (do wstawiania tabelek). zamiast dublowac kod mozna by tak: (defun C:Tabela01 () (TabelaFunkcja "01") (princ) ) (defun C:TABELA02 () (TabelaFunkcja "02") (princ) ) (defun C:TABELA03 () (TabelaFunkcja "03") (princ) ) (defun C:TABELA04 () (TabelaFunkcja "04") (princ) ) (defun TabelaFunkcja (Numer / OLDCMD TB PT) (setq OLDCMD (getvar 'CMDECHO)) (if (findfile (setq TB (strcat "profilek_tabelka" Numer ".dwg"))) (if (setq PT (getpoint "\nWskaż punkt wstawienia tabeli: ")) (progn (setvar 'CMDECHO 0) (command "_-insert" TB PT "" "" "") ) (princ "\nNiepoprawny punkt. ") ) (princ (strcat "\nNie znaleziono pliku \"" TB "\" !")) ) (setvar 'CMDECHO OLDCMD) ) (princ) jesli jestes zainteresowany to moge podrzucic pare rozwiazan. j.

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.