LISP dla wszystkich otwartych, LTSCALE

[zwonko]

Próbuje stworzyć lispa który będzie ustawiał zmienną LTSCALE na wszystkich otwartych rysunków.

Generalnie bazując na:

(defun c:saveall ( / )
(vl-load-com)
 (vlax-for OpenDwgs (vla-get-documents (vlax-get-acad-object))
   (vla-save OpenDwgs)
 );; vlax-for
 (princ)
)

zmodyfikowałem na proste (dla gripobjlimit) i działa:

(defun c:gripobjlimitall ( / )
(vl-load-com)
 (vlax-for OpenDwgs (vla-get-documents (vlax-get-acad-object))
   (vla-setvariable OpenDwgs "gripobjlimit" 100)
 );; vlax-for
 (princ)
)

Niestety zmiana gripobjlimit na ltscale nie działa. Zmienia tylko ltscale na pierwszym rysunku. 

 

Próbowałem też 

(defun c:ltsallXXX2323SKACZE ( / )
  ;; lts all 1
  (vlax-for doc (vlax-get (vlax-get-acad-object) 'Documents)
(vla-postcommand doc (strcat "setvar " "ltscale " "1 "))

  );vlax-for doc
  (prompt "\nComplete.")
  (princ)
);defun

Ten znowu skaczę, tj. trzeba pare razy kliknąć na pierwszy otwarty rysunek (jego zakładkę, tab) lub wciskać ctrl+tab, żeby program przeskoczył przez wszystkie.

Próbowałem też inne wariacje typu:

    (vla-postcommand doc "lts 1 \n")
	(vla-postcommand doc (strcat "setvar " "ltscale " "1 "))
	(vl-cmdf "setvar" "ltscale" "1" "" )
	(vla-SendCommand doc (strcat "LTSCALE" " " "1" " "))
	(vla-SendCommand doc (strcat " " " " ))

Generalnie zrobiłem kilkadziesiąt prób, za każdym razem albo nie działa, albo jest skaczący. Próbowałem też dodawać aktywacje rysunku, czyli "emulować" klikanie na pierwszy, ale też nie pomogło.

 

Ktoś może wie jak to naprawić?

Do tego potrzebowałbym lispa który zamraża (freeze) konkretne warstwy (podpis,podpisy,Rpodpisy, itd) na otwartych rysunkach. Myślałem o sendcommand, postcommand, cmdf ale nie udało mi się osiągnąć żeby nie skakały.

[dmatusz3]

Nie jestem do końca pewien czy to można coś takiego osiągnąć, aby jeden lisp sterował kilkoma rysunkami.

Każdy rysunek ma odizolowaną przestrzeń do LISPa, aby zmienne z jednego rysunku nie wpływały na inny.

Udało się Panu zmienić zmienną 

Godzinę temu, zwonko napisał:

gripobjlimit

ale ta zmienna jest zapisywana w rejestrze. Więc zmiana w jednym otwartym rysunku powoduje zmianę w rejestrze i inne rysunku ją widzą.

Natomiast zmienna LTSCALE jest zapisywana w pliku dwg i dla każdego rysunku może być inna.

Być może rozwiązaniem byłby zapis wartości zmiennej do pliku zewnętrznego, tak aby inne rysunki mogły sobie odczytać tę wartość. Ale raczej nie będzie to proste.

[Martin_S]

tez cos podobnego zauwazyłem , dlatego np. e-cad od 2009 ma stała LT =10

center2 i hidden wygląda estetycznie i rys. jest "idiotoodporny" i tak 12 lat 😉 sie sprawdziło

 

...a architekci z automatu LT = 1 lub 100

[perlon]

(defun c:ltscaleall ( / )
	(vl-load-com)
	(vlax-for OpenDwgs (vla-get-documents (vlax-get-acad-object)) 
		(progn 
			(print OpenDwgs) 
			(vla-activate OpenDwgs) 
			(setvar "ltscale" 200)
			(princ)
		)
	)
	(princ)
)

Ale niestety mimo że lisp zamiata po otwartych rysunkach to ltscale ustawia tylko w tym z którego jest odpalony lisp. Wg mnie lispem tego sie nie da ale powinno się dać skryptem który otworzy plik coś zrobi i zamknie plik.

[perlon]

Podpierając się lispem LeeMac'a można wybrać kartotekę z plikami dwg i w czambuł polecieć wszystkie wygenerowanym skryptem.

(defun C:LTSALLDWG ( / count dir filename files scriptname)
    (setq dir (LM:DirectoryDialog "Select directory" "" 1))
    (if dir
        (setq files (vl-directory-files dir "*.dwg" 1))
    )
    (if files
        (progn
            (setq scriptname (open "e:\\temp\\batch.scr" "w")
                  count 0
            )
            (while (setq filename (nth count files))
                
                (setq filename (strcat dir "\\" filename))
                (write-line (strcat "_open \"" filename "\"") scriptname)
                (write-line (strcat "(vl-cmdf \"" "setvar\"" " " "\"" "ltscale\"" " " "\"1\"" " " "\""  "\"" ")") scriptname)
                (write-line "_qsave" scriptname)
                (write-line "_close" scriptname)
                (setq count (1+ count))
            )
            (close scriptname)
        )
    )
    (princ)
)

;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - message to display at top of dialog                ;;
;;  dir  - root directory (or nil)                            ;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:DirectoryDialog ( msg dir flag / Shell Fold Self Path )
  (vl-catch-all-apply
    (function
      (lambda ( / ac HWND )
        (if
          (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
                HWND  (vl-catch-all-apply 'vla-get-HWND (list ac))
                Fold  (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir)
          )
          (setq Self (vlax-get-property Fold 'Self)
                Path (vlax-get-property Self 'Path)
                Path (vl-string-right-trim "\\" (vl-string-translate "/" "\\" Path))
          )
        )
      )
    )
  )
  (if Self  (vlax-release-object  Self))
  (if Fold  (vlax-release-object  Fold))
  (if Shell (vlax-release-object Shell))
  Path
)


;Symbol 	 Type    	Description
;msg 	 String 	Message to display to the top of the dialog (may be an empty string)
;dir 	 String 	(Optional) Root Directory, user cannot navigate above this level
;flag 	 Integer 	Bit flags controlling the behaviour of the dialog interface (detailed below)

;Returns: Selected Directory, else nil if user presses Cancel



;Flag Bit Values
;Bit 	Result
;0 	Standard behaviour (Default)
;1 	Only file system folders can be selected. If this bit is set, the OK button is disabled if the user selects a folder that doesn't belong to the file system.
;2 	The user is prohibited from browsing below the domain within a network
;4 	Room for status text is provided under the dialog box
;8 	Returns file system ancestors only. An ancestor is a subfolder that is beneath the root folder. If the user selects an ancestor of the root folder that is not part of the file system, the OK button is grayed.
;16 	Shows an edit box in the dialog box for the user to type the name of an item.
;32 	Validate the name typed in the edit box.
;64 	Enable drag-and-drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands.
;128 	The browse dialog box can display URLs.
;256 	When combined with flag 64, adds a usage hint to the dialog box, in place of the edit box.
;512 	Suppresses display of the 'New Folder' button
;1024 	When the selected item is a shortcut, return the PIDL of the shortcut itself rather than its target.
;4096 	Enables the user to browse the network branch for computer names. If the user selects anything other than a computer, the OK button is grayed.
;8192 	Enables the user to browse the network branch for printer names. If the user selects anything other than a printer, the OK button is grayed.
;16384 	Allows browsing for everything: the browse dialog box displays files as well as folders.
;32768 	If combined with flag 64, the browse dialog box can display shareable resources on remote systems.
;65536 	Windows7 & later: Allow folder junctions such as a library or a compressed file with a .zip file name extension to be browsed.

 

[zwonko]

Dzięki to akurat się przyda.

Nie mniej jednak pisałem jeszcze o ustawianiu warstwy, znaczy zamrozeniu (freeze). Tam chyba jednak będę posiłkował się tym co mam, klikając na pierwszy rysunek (lub robiąc crtl+tab). Bo tego będę potrzebował używać do publish, i często rysunki (niestety) są rozsiane po różnych katalogach.

[perlon]

Może wystarczy do skryptu dorzucić jedną linijkę i będzie zamrażanie warstw

(write-line (strcat "(vl-cmdf \"" "_.layer\"" " " "\"" "_freeze\"" " " "\"*podpisy*,*opisy*\"" " " "\""  "\"" ")") scriptname)

A generator skryptu można przerobić żeby lista plików była na wejściu z jakiegoś pliku zewnętrznego. Wtedy można przerabiać pliki z różnych lokalizacji i wybiórczo.

[zwonko]

Właśnie tak sobie myślę, że jakby można było zrobić lispa który najpierw generuje listę otwartych plików a potem do niej to stosuje to byłoby super. Coś takiego ma chyba BFInd od LeeMac, ale ja jestem za cienki żeby to przerabiać.

[perlon]

Powinno zabanglać

(defun C:LTSALLDWG ( / filename doc scriptname)
	(setq scriptname (open "e:\\temp\\batch.scr" "w"))
	(vlax-for doc (vla-get-documents (vlax-get-acad-object))
		(progn
			(setq filename (vla-get-FullName doc))
			(write-line (strcat "_open \"" filename "\"") scriptname)
			(write-line (strcat "(vl-cmdf \"" "setvar\"" " " "\"" "ltscale\"" " " "\"1\"" " " "\""  "\"" ")") scriptname)
			(write-line (strcat "(vl-cmdf \"" "_.layer\"" " " "\"" "_freeze\"" " " "\"*podpisy*,*opisy*\"" " " "\""  "\"" ")") scriptname)
			(write-line "_qsave" scriptname)
			(write-line "_close" scriptname)
		)
	)
	(close scriptname)
    (princ)
)

Ale musisz pamiętać, żeby przed odpaleniem skryptu zamknąć wszystkie rysunki, Możesz usunąć ostatnią linijkę z _close to wtedy rysunki ze skryptu pozostaną otwarte.

Edytowane 23 Lipca 2021 przez perlon

[zwonko]

to już robi robotę!! dzięki!!

dołożyłem jeszcze parę linijek pod koniec żeby skrypt odpalał się sam:

(defun C:LTSALLDWG ( / filename doc scriptname)
	(setq scriptname (open "d:\\#temp\\tmp\\batch.scr" "w"))
	(vlax-for doc (vla-get-documents (vlax-get-acad-object))
		(progn
			(setq filename (vla-get-FullName doc))
			(write-line (strcat "_open \"" filename "\"") scriptname)
			(write-line (strcat "(vl-cmdf \"" "setvar\"" " " "\"" "ltscale\"" " " "\"1\"" " " "\""  "\"" ")") scriptname)
			(write-line (strcat "(vl-cmdf \"" "_.layer\"" " " "\"" "_freeze\"" " " "\"*podpis*,*podpisy*,*RS podpis*\"" " " "\""  "\"" ")") scriptname)
			(write-line "_qsave" scriptname)
		)
	)
	(close scriptname)
(command "filedia" "0")
(command "new" " ")
(command "closeall")
(command "script" "d:\\#temp\\tmp\\batch.scr")
(command "filedia" "1")
    (princ)
)

W przyszłości musze sobie jeszcze go wyedytować, tak żeby pytał czy chce włączyć czy wyłączyć podpisy, bo niestety czesto tak jest ze trzeba wyplotować z podpisem oraz bez.

Czy jest możliwość żeby ustawić że skryp będzie lądować w C:\Users\XXX\AppData\Local\Temp (i odpalać się z tego miejsca)? Znaczy wiem że jest z palca bo sam zmieniłem ścieżkę, ale żeby lisp był bardziej uniwersalny pasuje żeby w miejsce XXX wskakiwał aktualny użytkownik.

 

[perlon]

(getvar "loginname")

 

[zwonko]

można prosić jeszcze jakieś objaśnienie do pisania tych "write-linów". Strasznie dużo tam apostrofów i slashy. Gubię się w tym (bo nie wiem o co chodzi) a potrzebuje napisać coś w stylu:

(load "DeleteBlocksV1-0.lsp" nil) (if LM:DeleteBlocks (LM:DeleteBlocks (LM:acdoc) '("nazwa1" "nazwa2" "nazwa3" "nazwa4" "nazwa5")))

tak żeby skrypt usuwał bloki podpisów. Próbowałem do tego jakoś dojść ale mam problem zwłasz z nawiasami i apostrofami.

[perlon]

wrilte-line potrzebuje jako argument stringa. w strcat mamy listę stringów do sklejenia każdy z elementów musi być zamknięty w cudzysłowy chyba że ma być sklejona wartość zmiennej np. filename ele nazwa pliku w skrypcie ,usi byc zamknięta w cudzysłowy więc w strcat musimy wrzucić również cudzusłowy. żeby uzyskać cudzysłow w skrypcie trzeba zrobić coś takiego : (strcat "_open " "cudzysłow" filename "cudzysłów" "spacja" "cudzysłów" "_ltscale" "cudzysłów" "spacja" "cudzysłów" "1" "cudzysłów")

zamień teraz spacja na znak spacji i cudzysłów na parę znaków \" i otrzymasz taki ciekawy ciąg.

(strcat "_open " "\"" filename "\"" " " "\"" "_ltscale" "\"" " " "\"" "1" "\"")

Dwa cudzysłowy obok siebie to "\"" "\"" powinno zadziałać "\"\"". Jakoś się nad tym zmóżdżałem.  Można zapewne przyklejać spacje do poprzedzających ciągów  ale u mnie to są oddzielne ciągi więc tych cudzysłowów się trochę narobiło.

 

W sumie to chyba faktycznie przegiąłem. Obie linie dają ten sam efekt

    (write-line "(vl-cmdf \"setvar\" \"ltscale\" \"1\" \"\")" scriptname)

    (write-line (strcat "(vl-cmdf \"" "setvar\"" " " "\"" "ltscale\"" " " "\"1\"" " " "\""  "\"" ")") scriptname)

 

Edytowane 27 Lipca 2021 przez perlon

[zwonko]

Po długich a ciężkich, i Twoim tłumaczeniu @perlon zajarzyłem.

Podsumowując zamiast cudzysłowiu trzeba napisać \". Żeby odczytywał to strcat to musi być tak naprawdę "\"".  Jeszcze łącząc to np. z vl-cmdf gdzie każdy "wpisany element" musi być w cudzysłowiu, mamy na prawdę sieczkę.

Dodam jeszcze co dopisałem, może komuś się przyda.

(setq line (strcat "(load \"" "DeleteBlocksV1-0.lsp\"" " nil" ")" " (if " "LM:DeleteBlocks " "(" "LM:DeleteBlocks " "(" "LM:acdoc" ") " "'" "(" "\"blokA\" " "\"blok_B\" " "\"blok C\" " ")))"))
			(write-line line scriptname)

(setq line (strcat "(vl-cmdf" " " "\"-purge\"" " " "\"b\"" " " "\"" "*" "\"" " " "\"" "n" "\"" ")"))
			(write-line line scriptname)
		(write-line "_qsave" scriptname)

W ten sposób, lisp delete block usuwa z rysunku bloki (ale definicja bloku zostaje). Następnie jeszcze wywołujemy purge żeby rysunek został wyczyszczony z tych bloków (z definicji).

 

Jeszcze raz dziękuję @perlon

Edytowane 27 Lipca 2021 przez zwonko