lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms..
Lista Forumurilor Pe Tematici
lisp2arx | Reguli | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat.
Nou pe simpatie:
Profil Criscristina92
Femeie
25 ani
Bucuresti
cauta Barbat
29 - 80 ani
lisp2arx / Listof AutoLisp.100 / vla-AutoLispR4-Multiple SetVar's With OneFunction,SysVar+GetVar Moderat de zauchan
Autor
Mesaj Pagini: 1
admin
Administrator

Din: Bucharest
Inregistrat: acum 13 ani
Postari: 516
QEN: How to replace multiple SetVar's With One Function?
ROM: Dvs. utilizati functia  "syst_setvars. Daca una din variabile da,crash sau genereaza
eroare atunci dvs, tastati  (princ syst_setVarName)
Both Getvar and SetVar are injected inside syst_setvar .

Pentru pushall, dvs utilizati (setq poplist (syst_setvars lpt))
Pentru restore, dvs scrieti (syst_setvars poplist);

Code:

;; end of *error* function
  (setq    cmde (getvar "cmdecho")
    blip (getvar "blipmode")
    ltsc (getvar "celtscale")
    cclr (getvar "cecolor")
    snap (getvar "osmode")
    pwid (getvar "plinewid")
    clyr (getvar "clayer")
    pgen (getvar "plinegen")
  )
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (setvar "plinewid" 0)
  (setvar "plinegen" 1)

This list of setvar and getval will be,

Code:

lpt (list (list "CMDECHO" 0) 
                         (list "BLIPMODE" 0) 
                         (list "OSMODE" 0) 
                         (list "PLINEWID" 0) 
                         (list "PLINEGEN" 1) 
                         (list "CELTSCALE" nil) 
                         (list "CECOLOR" nil) 
                         (list "CLAYER" "0"))

(setq syst_setVarName "Author: DragneAdrian2009")



Code:

(Defun syst_setvars(listavar / $rr kg lg cf om)  ;_ASSERT_OK
  (setq;|a3835|;
     $rr nil
     lg listavar) (progn (setq;|a3869|;
     kg 0) (while (/= (car lg) nil) (if (=  (type (caar lg)) 
     (quote STR)) (progn (setq;|a3943|;
     syst_setVarName (caar lg)
     om (getvar syst_setVarName)
     $rr (if om (append $rr (list syst_setVarName)) $rr)
     cf (cadar lg)
     om (if (=  cf nil) nil om)
     om (if (=  cf T) nil om)
     om (if om (setvar syst_setVarName cf) nil)
     kg (if om (+ kg 1) kg)))) (setq;|a4221|;
     lg (cddr lg)))) 
$rr)



_______________________________________


pus acum 4 ani
   
admin
Administrator

Din: Bucharest
Inregistrat: acum 13 ani
Postari: 516


Code:

(defun *error* (x)
      (syst_setvars lpt)
      (princ x)
      (setq *error* olderr)
     (princ)
   )

/*c2s: 
     lpt=list(list("CMDECHO",0),
              list("BLIPMODE",0),
              list("OSMODE",0),
              list("PLINEWID",0),
              list("PLINEGEN",1),
              list("CELTSCALE",nil),
              list("CECOLOR",nil),
              list("CLAYER","0")
            );
       lpt=syst_setvars(lpt);



setvar's with *error* (x)
 lpt)
 (princ x)
 (setq *error* olderr)
 (princ)
 )

/*c2s: );

37.1KB


_______________________________________


pus acum 4 ani
   
zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180
; System Variable saving/resetting without separate variables for each:

Code:

(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq   svn (list "osmode" "cmdecho" "ucsfollow" "blipmode")
            svv (mapcar (quote getvar) svn)
  ); setq

;|  DivideMaxPoints.lsp [command name: DMP]
  Kent Cooper, 20 July 2020

Code:

(mapcar (quote setvar) svn (list 0 0 0 0))
     ; turn off applicable System Variables

AutoDeskj forum= hosneyalaa  in reply to: kajanthangavel

Code:

(setq
    svnames (list  "osmode"  "cmdecho"  "blipmode" "plinewid")
    svvals (mapcar 'getvar svnames)
  ); setq
.....................................
(mapcar 'setvar svnames svvals)
(princ)
(mapcar 'setvar svnames '(0 0 0 0))



_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 4 ani
   
admin
Administrator

Din: Bucharest
Inregistrat: acum 13 ani
Postari: 516


Code:

(MAPCAR (quote SETVAR)
 (quote
        ("skpoly" "snapmode" "orthomode" "cmdecho" "plinetype")
      )
      (quote (1 0 0 1 0))
 )



Code:

(setq svnames (list "osmode" "cmdecho" "blipmode" "plinewid"))
(setq svvals (mapcar (quote getvar) svnames))
(alert "Author:=kajanthangavel")
(alert "You type here your-program code")
(mapcar (quote setvar) svnames svvals)



setvar's with (quote setvar)
 (quote
 (quote 0))
 svnames (list svvals (mapcar (quote getvar)

76.5KB


_______________________________________


pus acum 4 ani
   
zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180


Code:

(terpri)
(foreach var
     (list 
       (list "ANNOMONITOR" . 0)
       (list "CMDECHO" . 0)
       (list "COORDS" . 2)
       (list "CENTERMT" . 0)
       (list "DIMADEC" . 8)
       (list "DISPSILH" . 1)
       (list "EXPERT" . 5);    NEW
       (list "EXPLMODE" . 1);
       (list "FACETRES" . 2)
       (list "HIDEPRECISION" . 1)
       (list "INTERSECTIONDISPLAY" . 1)
       (list "IMAGEFRAME" . 2)
       (list "LAYEREVAL" . 0)    
       ;(list "LUNITS" . 4)
       (list "LUPREC" . 8)
       (list "LWDISPLAY" . 0)
       ;mleaderscale removed from below modemacro
       (list "MODEMACRO" . "$(if,$(eq,$(getvar,pstylemode),0),\"STB DWG\" ,\"CTB DWG\") \"  |  OsnapZ: \"$(if,$(eq,$(getvar,osnapz),0),\"OFF\" ,\"ON\") \" |  Txt S: \" $(RTOS, $(*,$(getvar,TEXTSIZE),8)[, 2, 2])\"  |  Dim S: \" $(RTOS, $(getvar,DIMSCALE)[, 2, 2]) \"  |  LTS: \" $(getvar,LTSCALE) \"  |  OS \" $(getvar,osmode) \"  |  Profile \" $(getvar,cprofile) \"  |  Mtext Editor: \" $(getvar,mtexted) \"  |  CenterMT: \" $(if,$(eq,$(getvar,centermt),0),\"Not Centered\" ,\"Centered\")")
           ;(list "NAVVCUBEDISPLAY" . 0)
       (list "OSNAPZ" . 0)
       (list "PDMODE" . 34)
       (list "PDSIZE" . 0.25)
           (list "SNAPMODE" . 0)
       (list "SNAPSTYL" . 0)
       (list "SNAPTYPE" . 0)
       (list "SOLIDHIST" . 0)
       (list "VISRETAIN" . 1)
       (list "VISRETAINMODE" . 0)
       );list
  (setvar (car var) (cdr var))
  (princ (strcat (car var) " set to "))
  (princ (Getvar (car var)))
  (terpri)
  );foreach



_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 4 ani
   
admin
Administrator

Din: Bucharest
Inregistrat: acum 13 ani
Postari: 516


Code:

(setq varl '("OSMODE" "CMDECHO" "DIMZIN")
         varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
   )

(setvar 'CMDECHO 0)
   (setvar 'DIMZIN  0)
   (setvar 'OSMODE  0)

Code:

(defun *error* (msg)
        (mapcar 'eval varl)
        (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
           (princ (strcat "\nError: " msg))
        )
        (and *AcadDoc* (vla-endundomark *AcadDoc*))
        (princ)
   )



Code:

(foreach sys
  '(l
        (lpdfshx     0)
        (epdfshx    0)
        (imageframe 2)
        (pdfframe   2)
        (pellipse   1)
        (fontalt        "arial")
    )
    (if (getvar (car sys)) (apply 'setvar sys))
)



_______________________________________


pus acum 4 ani
   
zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180


Code:

(setq varlist (list "CMDECHO" "CLAYER")
        oldvars
        (mapcar 'getvar varlist)
        )



Code:

(Defun q-start () (setq org-err *error* *error* q-finish) (setvar "cmdecho" 0))

(Defun finish () (mapcar 'setvar (list "attreq" "cecolor" "celtype" "clayer" "cmddia" "cmdecho" "filedia" "insunits" "mbuttonpan" "osmode" "pickfirst" "texteval" "visretain") var_list) (setq *error* org-err) (princ))



Code:

(Defun C:AG (/ ss elast newbies sp1 sp2 dp1 dp2)    ;Ctrl has special functions in BricsCAD so had to switch to Shift
    (start)
    (Command "Undo" "be")
    (prompt "\nHit 'Shift Enter' to Copy Object")(setq ss (ssget))
    (if (acet-sys-shift-down)
        (progn (setq elast (ALE_LastEnt) newbies (ssadd))(vl-cmdf "copy" "p" "" "0,0,0" "0,0,0")(setq ss (ALE_Ss-After elast)))
    )
    (setvar 'osmode 2561)
    (if (acet-sys-shift-down)
    (command "mirror" ss "" dp1 dp2 "y")
    )
    (Command "Undo" "e")
    (finish)
    )



_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 4 ani
   
admin
Administrator

Din: Bucharest
Inregistrat: acum 13 ani
Postari: 516
; Copyright (c) 2006
; Ronald Peterson
; (Y) Yellowbank
; All rights reserved.  Applicable GPL license terms can be found in
; the associated LICENSE file.

Code:

(defun sysvarinit (varlist / var state) 
                        ;; varlist like:
                        ;; '("cmdecho" "blipmode" "osmode" "pdsize")
    (setq SYSVARSTATE nil)
    (foreach var varlist
        (setq state (getvar var))
        (setq SYSVARSTATE (cons (list var state) SYSVARSTATE))
        (eval (list 'setvar var 0))
    )
)

xxxxxxxxxxxxxxxxxx
(defun c:it()
    (sysvarinit '("cmdecho" "blipmode" "osmode" "orthomode")
    (command ".undo" "group"
    (insert_tiff)
    (command ".undo" "end"
    (sysvarrestore)
    (prin1)
)
-------------------------------

Code:

(defun sysvarrestore (/ item)
    (foreach item SYSVARSTATE
        (eval (cons 'setvar item))
    )
)

---------------------------
(defun c:gg1()
    (sysvarinit '("cmdecho" "blipmode" "osmode")
    (command ".undo" "group"
    (gg1)
    (command ".undo" "end"
    (sysvarrestore)
    (prin1)
)

----------------------
(defun c:cr()
    (sysvarinit '("cmdecho" "blipmode" "osmode")
    (command ".undo" "group"
    (cr)
    (command ".undo" "end"
    (sysvarrestore)
    (prin1)
)


_______________________________________


pus acum 4 ani
   
Pagini: 1  

Mergi la