Topic: Selection set help

[csgoh]

 Hi all;
I have written this lisp but am puzzled when I tested.
If I test run the "bsp" routine before running "w2", I don't get an error.
However, if I run "w2" first and then "bsp", I get this error
; error: An error has occurred inside the *error* functionbad argument type: stringp nil
It would be appreciated if someone could correct my problem.
Thanks
My code

Code: [Select]


(defun c:Dob()
 (vlax-dump-object (vlax-ename->vla-object (car(entsel "Sel object"))) T)
)
;
; wg:setting
;
(defun wg:setting ()
 (setq oerr *error*               ;save *error*
       *error* wg:err                ;reassign *error*
 )
 (setvar "CMDECHO" 0)
 (setvar "BLIPMODE" 0)
 (setvar "dimzin" 0)
 (setvar "Expert" 4)
;name the current ucs
 (command "ucs" "s" "wgcurrentucstemp")
 (setvar "Expert" current-EXPERT)
 (princ)
); wg:setting

;
; subroutine resetting
;
(defun wg:resetting ()
 (setvar "Expert" 4)
 (command "ucs" "r" "wgcurrentucstemp")
 (command "ucs" "d" "wgcurrentucstemp")
 (setvar "Expert" current-EXPERT)
 (SETVAR "CMDECHO" current-CMDECHO)
 (setvar "BLIPMODE" current-BLIPMODE)
 (setvar "CLAYER" current-LAYER)
 (setvar "TEXTSTYLE" current-TEXTSTYLE)
 (setvar "OSMODE" current-OSMODE)
 (setvar "DIMZIN" current-DIMZIN)
 (setvar "ERRNO" current-ERRNO)
 (princ)
 (setq *error* oerr)    ;RESET ERROR
; AUTHORS MESSAGE
 (princ (strcat "\nProgram New-Wingoh " prog$ " by CS GOH"))
 (princ)
); wg:resetting
 
;
;ERROR TRAP
;
(defun wg:err (s)
 (if (= s "Function cancelled")
  (princ (strcat "\nPROGRAM - " prog$ " Cancelled: "))
  (progn
   (princ (strcat "\nPROGRAM - " prog$ " Error: " s))
   (princ)
  )
 ) ; if
 (wg:resetting)
 (princ "\nSYSTEM VARIABLES have been reset\n")
 (princ)
); wg:err


;;doslib loading
;(defun c:dblip()
;; Check for AutoCAD 2000, 2000i, or 2002
;(if (= "15" (substr (getvar "acadver") 1 2))
;  (if (not (member "doslib15.arx" (arx)))
;   (if (findfile "doslib15.arx")
;    (progn
;     (arxload "doslib15")
;     (PRINC "\ndoslib15 loaded")
;    )
;   )
;   (princ "\ndoslib15 is already loaded")
;  )
;)
;; Check for AutoCAD 2004, or 2005
;(if (= "16" (substr (getvar "acadver") 1 2))
; (if (not (member "doslib16.arx" (arx)))
;  (if (findfile "doslib16.arx")
;   (PROGN
;    (arxload "doslib16")
;    (PRINC "\ndoslib16 loaded")
;   )
;  )
;  (princ "\ndoslib16 is already loaded")
; )
;)
;);dblib
;(c:dblip)



;list of functions
; c:dblip – doslib loading
; c:w2 – scale,txheight,dist input
; bsp  - to space out bearing texts
; chp  - mcorr all entities selected
; nul  - nullify all entities selected
; ptty – change point type to + or .
; tarinfo – write julian dates for demo lsp
; demolsp – for demo purposes only to check it when necessary
; add – to add prefix
; cpri – change prefix
; qw – to change the RL no of decimals
; st2 – to change texts width or the textstyle
; unloadnewwg – unload newwingoh menu
;(load "c:/goh/acadr14/wingoh2.lsp")

;(defun c:unloadnewwg()
; (command "menuunload" "newwingoh")
;(princ)
;); end unloadnewwg

;LOAD SUBROUTINES.LSP
;(load "subroutines.lsp")

;
;set units
;meters,clockwise,etc
(defun WG:setunits()
  (setvar "lunits" 2)
  (setvar "luprec" 4)
  (setvar "aunits" 1)
  (setvar "auprec" 3)
   (if (and (/= (getvar "ANGBASE")(/ pi 2))(/= (getvar "ANGDIR") 1))
    (progn
     (setvar "angbase" (/ pi 2))
     (setvar "angdir" 1)
    )
   )
); WG:setunits





;C:W2
(defun c:w2(/ prog$)
 (setq prog$ "W2")
;global names
 (vl-load-com)
 (setq acadObj(vlax-get-acad-object)   ; acad Object
       ActivedocumentObj (vla-get-Activedocument acadObj) ; the current dwg
       modelspaceObj (vla-get-modelspace ActivedocumentObj) ; the modelspace
       current-LAYER (getvar "CLAYER")
       current-CMDECHO (getvar "CMDECHO")
       current-BLIPMODE (getvar "BLIPMODE")
       current-TEXTSTYLE (getvar "TEXTSTYLE")
       current-OSMODE (getvar "OSMODE")
       current-DIMZIN (getvar "DIMZIN")
       current-ERRNO (getvar "ERRNO")
       current-EXPERT (getvar "EXPERT") ; CURRENT SYSTEM VARIALBES
 )
 (WG:load-new-linetypes)
 (WG:create-layers)
 (WG:create-textstyles)
 (WG:acad-cfg) ; cfg file
 (wg:setting)

;set units,meters,clockwise
 (WG:setunits)
;plot scale,th,etc
 (wg:met)
 (princ)
); w2

(defun WG:makela(lan1 lac1 lalt1 / prog$ lan2)
 (setq prog$ "WG:makela")
 (setq lan2 (vl-catch-all-apply 'vla-add (list objLayers lan1)))
 (if (not (vl-catch-all-error-p lan2))
  (progn
   (vla-put-color lan2 lac1)
   (vla-put-linetype lan2 lalt1)
    (princ (strcat "\nLayer " lan1 " created ...."))
  )
 );if
);WG:makela

(defun WG:activate-layer(lan1 / prog$)
 (setq prog$ "WG:activate-layer")
   (vla-put-Freeze (vla-item objLayers lan1) :vlax-false)
   (vla-put-Layeron (vla-item objLayers lan1) :vlax-true)
   (vla-put-Lock (vla-item objLayers lan1) :vlax-false)
   (princ (strcat "\nLayer " lan1 " on,thawed & unlocked ...."))
);WG:activate-layer

;13-4-05
;create the nine layers
(defun WG:create-layers( / prog$ objLayers lan lac lalt layerlist)
 (setq prog$ "WG:create-layers")
 (setq objLayers (vla-get-layers ActivedocumentObj)
      layerlist (WG:GetName-any-type objLayers)
 )

 (setq lan "BGDIST" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "BLUELN" lac 5 lalt  "DASHED")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "LOTARE" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "GRIDTXT" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "TRAVLN" lac 9 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "TABLE" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "TABNO" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "BDLABEL" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "BLUETX" lac 5 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
  (princ)
);WG:create-layers


;13-4-05
;get names of all layers,linetypes,textstyles
(defun WG:GetName-any-type(obj? / prog$ name? theList)
  (setq prog$ "WG:GetName-any-type")
  (setq theList '())
  (vlax-for each-item obj?
    (setq name? (strcase (vla-get-name each-item))
   theList (cons name? theList)
    )
  );vlax-for
 thelist
);WG:GetName-any-type


;13-4-05
;create new  textstyles
;make WG1 & W785 textstyle if absent
(defun WG:Create-textstyles(
/ prog$ textstyleList anewTxtstyle objTextstyles
)
  (setq prog$ "WG:Create-textstyles")
  (setq objTextstyles (vla-get-Textstyles ActivedocumentObj)
        textstylelist (WG:GetName-any-type objTextstyles)
  )
  (if (not (member "W785" textstylelist))
   (progn
    (setq anewTxtstyle(vla-add objTextstyles "W785"))
    (vla-put-fontFile anewTxtstyle "SIMPLEX.SHX")
    (vla-put-width anewTxtstyle 0.785)
    (princ "\nTextstyle W785 created ....")
   )
   (progn
    (princ "\nTextstyle W785 exists ....")
   )
  );if
  (if (not (member "WG1" textstylelist))
   (progn
    (setq anewTxtstyle(vla-add objTextstyles "WG1"))
    (vla-put-fontFile anewTxtstyle "WINGOH.SHX")
    (vla-put-width anewTxtstyle 0.785)
    (princ "\nTextstyle WG1 created ....")
   )
   (progn
    (princ "\nTextstyle WG1 exists ....")
   )
  );if
);WG:Get-All-Textstyles


;13-4-05
; load linetypes
(defun WG:load-new-linetypes( / prog$ objLinetypes linetypelist)
 (setq prog$ "WG:load-new-linetypes")
 (setq objLinetypes (vla-Get-Linetypes ActivedocumentObj)
       linetypelist (WG:GetName-any-type objLinetypes)
 )

 (if (not (member "DASHED" linetypelist))
  (progn
   (vla-Load objLinetypes "DASHED" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nDASHED linetype loaded ....")
  )
  (progn
   (princ "\nDASHED linetype exists ....")
  )
 )

 (if (not (member "BARBWIRE" linetypelist))
  (progn
   (vla-Load objLinetypes "BARBWIRE" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nBARBWIRE linetype loaded ....")
  )
  (progn
   (princ "\nBARBWIRE linetype exists ....")
  )
 )

 (if (not (member "BARBWIRE2" linetypelist))
  (progn
   (vla-Load objLinetypes "BARBWIRE2" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nBARBWIRE2 linetype loaded ....")
  )
  (progn
   (princ "\nBARBWIRE2 linetype exists ....")
  )
 )

 (if (not (member "BARBWIREX2" linetypelist))
  (progn
   (vla-Load objLinetypes "BARBWIREX2" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nBARBWIREX2 linetype loaded ....")
  )
  (progn
   (princ "\nBARBWIREX2 linetype exists ....")
  )
 )

 (if (not (member "CHAINLINK" linetypelist))
  (progn
   (vla-Load objLinetypes "CHAINLINK" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nCHAINLINK linetype loaded ....")
  )
  (progn
   (princ "\nCHAINLINK linetype exists ....")
  )
 )

 (if (not (member "CHAINLINK2" linetypelist))
  (progn
   (vla-Load objLinetypes "CHAINLINK2" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nCHAINLINK2 linetype loaded ....")
  )
  (progn
   (princ "\nCHAINLINK2 linetype exists ....")
  )
 )

 (if (not (member "CHAINLINKX2" linetypelist))
  (progn
    (vla-Load objLinetypes "CHAINLINKX2" "C:/GOH/ACAR14/WINGOH.lin")
    (princ "\nCHAINLINKX2 linetype loaded ....")
  )
  (progn
   (princ "\nCHAINLINKX2 linetype exists ....")
  )
 )
 (princ)
); WG:load-new-linetypes



;16-5-04
;WG:acad-cfg
(defun WG:acad-cfg(/ A B C date3)
 (setq a (getvar "date")
       b (+ a 14)
       a (rtos a 2 6) ; start
       b (rtos b 2 6) ; end
       c (open "c:/WGdata.dat" "w")
 );
 (write-line b c)
 (close c)
; write to cfg file if it does not exist
 (SETQ date3(GETCFG "AppData/Wingoh/data1"))
 (if (= date3 nil)
  (progn
   (setcfg "AppData/Wingoh/data1" a)
   (setcfg "AppData/Wingoh/data2" b)
  )
 )
 (princ)
); WG:acad-cfg


;16-4-05
;
(defun wg:met( / prog$)
 (setq prog$ "met")

; Get plot scale
  (setq skala (wg:GetSkala skala)) ; get plotting scale
  (princ (strcat "\nPlotting scale set to 1 : " (itoa skala)))
; set various global constant values
  (wg:konstant)
  (princ)
);wg:met


;16-4-04
; wg:GetSkala
(defun wg:GetSkala( skala? / prog$ input?)
  (setq prog$ "GetSkala")
  (initget 6)
  (if (not skala?)
      (setq skala? 1000)
  )
  (setq input? (getint (strcat "\nEnter plotscale : <"
                                 (rtos skala? 2 0) "> ")
  ))

;  (setq input? (dos_getint "PLOTTING SCALE" "Enter scale" 6 skala?))

  (if input?
    (setq skala? input?)
  )
  skala?
);wg:GetSkala

(defun wg:konstant()
 (setq PIon2 (/ pi 2.00000)
       PIon8 (/ pi 8.00000)
       3PIon2 (* 3 PIon2)
       ft ""
       dgt_2 10
       $jft$ 4
       meter 0.3048
       msq "%%200"
       secf1 6 secf2 5.5 secf3 6 b30 nil szero "0" secf4 nil
       szero "0" spbj "" sp "sp" pt "." sp1 ""
       sdeg "%%D" smin "'" ssec "%%034"
 )

  (IF (NOT LINK$)(setq link$ 1.00))
  (IF (NOT LING$)(setq ling$ "m"))
  (IF (NOT DISTFNC)(setq distfnc "m"))

  (if (not tinggi)(setq tinggi 2)) ; text height at any scale
  (setq th (* tinggi (/ skala 1000.0)))
  (if (not dist-decimal)(setq dist-decimal 3)) ; distance decimal
  (if (not htdecimal)(setq htdecimal 3)) ; ht decimal
  (if (not txtsudut)(setq txtsudut 90.0000)); txtsudut
  (if (not brgdist-layer)(setq brgdist-layer "BDLABEL")) ; layer for brg & dist
  (if (not line-layer)(setq line-layer "TRAVLN")) ; layer for lines
  (if (not point-layer)(setq point-layer "TABNO")) ; layer for points.
  (if (not text-layer)(setq text-layer "TABLE")) ; layer for texts.
;brg/dist type
  (if (not type1)
   (progn
    (setq type1 1) ; brg & dist format
    (setq brg-dist-fmt type1)
    (setq brg-dist-fmttype "BG / D")
   )
  ); type1
 (setq brg-dist-fmttype-list (list "None" "BG / D" "D / BG" "BG /" "/ BG" "D /"
  "/ D" "BG,D /" "/ D,BG" "/ BG_D" "BG_D /"))

; brg -accy
 (if (not brg-accy)(setq brg-accy 1))
 (cond
  ((= brg-accy 1)
   (setq brg-accy-num 1)
  )
  ((= brg-accy 10)
   (setq brg-accy-num 2)
  )
  ((= brg-accy 30)
   (setq brg-accy-num 3)
  )
 );cond to control radio button for selection in dcl

(princ "\nAll constants set ....")
;dist function
 (wg:distfunction)
 (princ "\nDist function set ....")
); wg:konstant

;16-4-05
(defun wg:distfunction()
 (if (and (= msq "%%200")(= link$ 1.00))
  (progn
   (setq distfnc "m")
   (setq dist-input-list (list "m" "lg"))
  )
 )

 (if (and (= msq "%%200")(= link$ 0.201168))
  (progn
   (setq dist-input-list (list "m" "lg"))
   (setq distfnc "link")
  )
 )
);wg:distfunction

(defun wg:GetObjects-list ( whatobjects / objects-list obj selsets ss1 no-ent
)
  (setq objects-list nil
obj     nil
  ) ;_ end of setq
  (setq selsets (vla-get-selectionsets ActivedocumentObj))
  (setq ss1 (vlax-make-variant "ss1"))
  (if (= (vla-get-count selsets) 0)
    (setq ssobj (vla-add selsets ss1))
  ) ;_ end of if
  (vla-clear ssobj)
  (setq no-ent 1)
  (while no-ent
    (vla-Selectonscreen ssobj)
    (if (> (vla-get-count ssobj) 0)
      (progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
 (setq
   obj (vla-item ssobj
 (vlax-make-variant (setq i (1+ i)))
) ;_ end of vla-item
 ) ;_ end of setq
 (cond
   ((vl-position (vlax-get-property obj "ObjectName") whatobjects)
    (setq objects-list
   (append objects-list (list obj))
    ) ;_ end of setq
   )
 ) ;_ end-of cond
) ;_ end of repeat
      ) ;_ end of progn
      (prompt "\nNo entities selected, try again.")
    ) ;_ end of if
    (if (and (= nil no-ent) (= nil objects-list))
      (progn
(setq no-ent 1)
(princ "\nNo ")(princ whatobjects)(princ " selected.\n")
(quit)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while  
 ;error to be this following line????
 (vla-delete (vla-item selsets 0))
  objects-list
) ;_ wg:GetObjects-list



(defun c:BSP ()
  (vl-load-com)
  (setq ActivedocumentObj (vla-get-activedocument
(vlax-get-acad-object)
     ) ;_ end of vla-get-activedocument
  ) ;_ end of setq
  (setq AllObjects-list
(wg:GetObjects-list (list "AcDbText" "AcDbPolyline"))
  ) ;_ end of setq
  (if AllObjects-list
    (progn
      (setq n (- 1))
      (repeat (length AllObjects-list)
 (vlax-dump-object (nth (setq n(1+ n)) AllObjects-list) T)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of BSP

(prompt "Enter BSP to start: ")




Thanks.

csgoh

[SMadsen]

Try rewriting the entire thing without using a single global variable.
I know it's a vague answer but eliminating this simple source of errors (depending on global variables) will give you a proper opportunity to catch the real errors.

Example: wg:GetObjects-list is depending on two very different issues: a global object, ssobj, and a selection set collection with no members. If the function returns successfully, then ssobj will have been assigned but deleted from the collection. If the sset collection does have members then ssobj will be assumed to exist. If it exists, it will have been deleted and will cause an error. If it doesn't exist, it will never be created and will cause an error.
Making ssobj a local variable will force you to think of how to create it, how to handle it and how to clear it but, more importantly, it will eliminate some of the possible errors so that you can concentrate on the real errors. And there are plenty of errors in wg:GetObject-list without having to deal with errors triggered by assumptions of global values (testing it in an empty drawing actually caused me to shut down AutoCAD by brute force because of the unfortunate loop in wg:GetObject-list).

[csgoh]

Sounds like a major problem.  
Honestly, I do not have a clue on how to go about it.
Any pointers where I should start to debug?
I am still new to VisualLisp/ActiveX.
If i extract the wg:getobjects & the bsp function and put into another lsp file, it works ok. The question is where should I start looking?
Thanks.

csgoh

[Kerry]

That was going to be my advice too, but I stepped away in case someone had more patience than I have.

(testing it in an empty drawing actually caused me to shut down AutoCAD by brute force ..

ditto

also Have a look at reworking the location of the error deinition. It is better located as a local function in each of the primary commands.
.. there are several examples of the desirable way to bo this on the site.

also, get rid of the "_end of xxx " comments.

also, perhaps add a simple program description comment before each routine.

also add meaningfull prompts to your selection commands.

also, add some sort of assertion trap for the availability of files you are trying to load.

.. now, back in the real world . In the VL IDE Debug menu select Animate, Stop Once, Break on Error. Then from the view Menu display the Watch window
Split the screen so that Acad is on one side and the VLIDE is on the other ... then run the routine, you may be surprised with what you see.

[csgoh]

I manage to locate the error source and modified it.
My new code. Pls comment as much as possible Kerry, Stig.

Code: [Select]


(defun c:Dob()
 (vlax-dump-object (vlax-ename->vla-object (car(entsel "Sel object"))) T)
)
;
; wg:setting
; function set variables
;
(defun wg:setting ()
 (setq oerr *error*               ;save *error*
       *error* wg:err             ;reassign *error*
 )
 (setvar "CMDECHO" 0)
 (setvar "BLIPMODE" 0)
 (setvar "dimzin" 0)
 (setvar "Expert" 4)
;name the current ucs
 (command "ucs" "s" current-ucs)
 (setvar "Expert" current-EXPERT)
 (princ)
); wg:setting

;
; subroutine resetting
; resets the system to its original values
;
(defun wg:resetting ()
 (setvar "Expert" 4)
 (command "ucs" "r" "wgcurrentucstemp")
 (command "ucs" "d" "wgcurrentucstemp")
 (setvar "Expert" current-EXPERT)
 (SETVAR "CMDECHO" current-CMDECHO)
 (setvar "BLIPMODE" current-BLIPMODE)
 (setvar "CLAYER" current-LAYER)
 (setvar "TEXTSTYLE" current-TEXTSTYLE)
 (setvar "OSMODE" current-OSMODE)
 (setvar "DIMZIN" current-DIMZIN)
 (setvar "ERRNO" current-ERRNO)
 (princ)
 (setq *error* oerr)    ;RESET ERROR
; AUTHORS MESSAGE
 (princ (strcat "\nProgram New-Wingoh " prog$ " by CS GOH"))
 (princ)
); wg:resetting
 
;
;ERROR TRAP
;
(defun wg:err (s)
 (if (or (= s "Function cancelled")(= s "quit / exit abort"))
  (princ (strcat "\nPROGRAM - " prog$ " Cancelled/quit/abort "))
  (progn
   (princ (strcat "\nPROGRAM - " prog$ " Error: " s))
   (princ)
  )
 ) ; if
 (wg:resetting)
 (princ "\nSYSTEM VARIABLES have been reset\n")
 (princ)
); wg:err


;;doslib loading
;(defun c:dblip()
;; Check for AutoCAD 2000, 2000i, or 2002
;(if (= "15" (substr (getvar "acadver") 1 2))
;  (if (not (member "doslib15.arx" (arx)))
;   (if (findfile "doslib15.arx")
;    (progn
;     (arxload "doslib15")
;     (PRINC "\ndoslib15 loaded")
;    )
;   )
;   (princ "\ndoslib15 is already loaded")
;  )
;)
;; Check for AutoCAD 2004, or 2005
;(if (= "16" (substr (getvar "acadver") 1 2))
; (if (not (member "doslib16.arx" (arx)))
;  (if (findfile "doslib16.arx")
;   (PROGN
;    (arxload "doslib16")
;    (PRINC "\ndoslib16 loaded")
;   )
;  )
;  (princ "\ndoslib16 is already loaded")
; )
;)
;);dblib
;(c:dblip)



;list of functions
; c:dblip – doslib loading
; c:w2 – scale,txheight,dist input
; bsp  - to space out bearing texts
; chp  - mcorr all entities selected
; nul  - nullify all entities selected
; ptty – change point type to + or .
; tarinfo – write julian dates for demo lsp
; demolsp – for demo purposes only to check it when necessary
; add – to add prefix
; cpri – change prefix
; qw – to change the RL no of decimals
; st2 – to change texts width or the textstyle
; unloadnewwg – unload newwingoh menu
;(load "c:/goh/acadr14/wingoh2.lsp")

;(defun c:unloadnewwg()
; (command "menuunload" "newwingoh")
;(princ)
;); end unloadnewwg

;LOAD SUBROUTINES.LSP
;(load "subroutines.lsp")

;
; set units to meters
; sets direction to north and clockwise
;
(defun WG:setunits()
  (setvar "lunits" 2) ; units to meters
  (setvar "luprec" 4) ; 4 decimal precision
  (setvar "aunits" 1) ; angular units to dms
  (setvar "auprec" 3) ; precision 10d10'10"
   (if (and (/= (getvar "ANGBASE")(/ pi 2))(/= (getvar "ANGDIR") 1))
    (progn
     (setvar "angbase" (/ pi 2))
     (setvar "angdir" 1)
    )
   )
); WG:setunits





;
;C:W2
; function to get system variables
;
(defun c:w2(/ prog$)
 (setq prog$ "W2")
;global names
 (vl-load-com)
 (setq acadObj(vlax-get-acad-object)   ; acad Object
       ActivedocumentObj (vla-get-Activedocument acadObj) ; the current dwg
       modelspaceObj (vla-get-modelspace ActivedocumentObj) ; the modelspace
       current-ucs "wgcurrentucstemp"
       current-LAYER (getvar "CLAYER")
       current-CMDECHO (getvar "CMDECHO")
       current-BLIPMODE (getvar "BLIPMODE")
       current-TEXTSTYLE (getvar "TEXTSTYLE")
       current-OSMODE (getvar "OSMODE")
       current-DIMZIN (getvar "DIMZIN")
       current-ERRNO (getvar "ERRNO")
       current-EXPERT (getvar "EXPERT") ; CURRENT SYSTEM VARIALBES
 )
 (WG:load-new-linetypes)
 (WG:create-layers)
 (WG:create-textstyles)
 (WG:acad-cfg) ; cfg file
 (wg:setting)

;set units,meters,clockwise
 (WG:setunits)
;plot scale,th,etc
 (wg:met)
 (princ)
); w2

: wg:makela
; function to create layers if non existent
(defun WG:makela(lan1 lac1 lalt1 / prog$ lan2)
 (setq prog$ "WG:makela")
 (setq lan2 (vl-catch-all-apply 'vla-add (list objLayers lan1)))
 (if (not (vl-catch-all-error-p lan2))
  (progn
   (vla-put-color lan2 lac1)
   (vla-put-linetype lan2 lalt1)
    (princ (strcat "\nLayer " lan1 " created ...."))
  )
 );if
);WG:makela

; wg:activate-layer
; function to turn on, thaw and unlock if layers exist.
;
(defun WG:activate-layer(lan1 / prog$)
 (setq prog$ "WG:activate-layer")
   (vla-put-Freeze (vla-item objLayers lan1) :vlax-false)
   (vla-put-Layeron (vla-item objLayers lan1) :vlax-true)
   (vla-put-Lock (vla-item objLayers lan1) :vlax-false)
   (princ (strcat "\nLayer " lan1 " on,thawed & unlocked ...."))
);WG:activate-layer

; 13-4-05
; create the nine layers
(defun WG:create-layers( / prog$ objLayers lan lac lalt layerlist)
 (setq prog$ "WG:create-layers")
 (setq objLayers (vla-get-layers ActivedocumentObj)
      layerlist (WG:GetName-any-type objLayers)
 )

 (setq lan "BGDIST" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "BLUELN" lac 5 lalt  "DASHED")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "LOTARE" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "GRIDTXT" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "TRAVLN" lac 9 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "TABLE" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "TABNO" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "BDLABEL" lac 7 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
 (setq lan "BLUETX" lac 5 lalt "CONTINUOUS")
  (if (not (member lan layerlist))
   (wg:makela lan lac lalt)
   (wg:activate-layer lan)
  )
  (princ)
);WG:create-layers


;13-4-05
;Function to get names of all layers,linetypes or textstyles and put into list
;
(defun WG:GetName-any-type(obj? / prog$ name? theList)
  (setq prog$ "WG:GetName-any-type")
  (setq theList '())
  (vlax-for each-item obj?
    (setq name? (strcase (vla-get-name each-item))
   theList (cons name? theList)
    )
  );vlax-for
 thelist
);WG:GetName-any-type


;13-4-05
;create new  textstyles
;make WG1 & W785 textstyle if absent
(defun WG:Create-textstyles(
/ prog$ textstyleList anewTxtstyle objTextstyles
)
  (setq prog$ "WG:Create-textstyles")
  (setq objTextstyles (vla-get-Textstyles ActivedocumentObj)
        textstylelist (WG:GetName-any-type objTextstyles)
  )
  (if (not (member "W785" textstylelist))
   (progn
    (setq anewTxtstyle(vla-add objTextstyles "W785"))
    (vla-put-fontFile anewTxtstyle "SIMPLEX.SHX")
    (vla-put-width anewTxtstyle 0.785)
    (princ "\nTextstyle W785 created ....")
   )
   (progn
    (princ "\nTextstyle W785 exists ....")
   )
  );if
  (if (not (member "WG1" textstylelist))
   (progn
    (setq anewTxtstyle(vla-add objTextstyles "WG1"))
    (vla-put-fontFile anewTxtstyle "WINGOH.SHX")
    (vla-put-width anewTxtstyle 0.785)
    (princ "\nTextstyle WG1 created ....")
   )
   (progn
    (princ "\nTextstyle WG1 exists ....")
   )
  );if
);WG:Get-All-Textstyles


;13-4-05
; load linetypes
(defun WG:load-new-linetypes( / prog$ objLinetypes linetypelist)
 (setq prog$ "WG:load-new-linetypes")
 (setq objLinetypes (vla-Get-Linetypes ActivedocumentObj)
       linetypelist (WG:GetName-any-type objLinetypes)
 )

 (if (not (member "DASHED" linetypelist))
  (progn
   (vla-Load objLinetypes "DASHED" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nDASHED linetype loaded ....")
  )
  (progn
   (princ "\nDASHED linetype exists ....")
  )
 )

 (if (not (member "BARBWIRE" linetypelist))
  (progn
   (vla-Load objLinetypes "BARBWIRE" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nBARBWIRE linetype loaded ....")
  )
  (progn
   (princ "\nBARBWIRE linetype exists ....")
  )
 )

 (if (not (member "BARBWIRE2" linetypelist))
  (progn
   (vla-Load objLinetypes "BARBWIRE2" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nBARBWIRE2 linetype loaded ....")
  )
  (progn
   (princ "\nBARBWIRE2 linetype exists ....")
  )
 )

 (if (not (member "BARBWIREX2" linetypelist))
  (progn
   (vla-Load objLinetypes "BARBWIREX2" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nBARBWIREX2 linetype loaded ....")
  )
  (progn
   (princ "\nBARBWIREX2 linetype exists ....")
  )
 )

 (if (not (member "CHAINLINK" linetypelist))
  (progn
   (vla-Load objLinetypes "CHAINLINK" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nCHAINLINK linetype loaded ....")
  )
  (progn
   (princ "\nCHAINLINK linetype exists ....")
  )
 )

 (if (not (member "CHAINLINK2" linetypelist))
  (progn
   (vla-Load objLinetypes "CHAINLINK2" "C:/GOH/ACAR14/WINGOH.lin")
   (princ "\nCHAINLINK2 linetype loaded ....")
  )
  (progn
   (princ "\nCHAINLINK2 linetype exists ....")
  )
 )

 (if (not (member "CHAINLINKX2" linetypelist))
  (progn
    (vla-Load objLinetypes "CHAINLINKX2" "C:/GOH/ACAR14/WINGOH.lin")
    (princ "\nCHAINLINKX2 linetype loaded ....")
  )
  (progn
   (princ "\nCHAINLINKX2 linetype exists ....")
  )
 )
 (princ)
); WG:load-new-linetypes



;16-5-04
;WG:acad-cfg
(defun WG:acad-cfg(/ A B C date3)
 (setq a (getvar "date")
       b (+ a 14)
       a (rtos a 2 6) ; start
       b (rtos b 2 6) ; end
       c (open "c:/WGdata.dat" "w")
 );
 (write-line b c)
 (close c)
; write to cfg file if it does not exist
 (SETQ date3(GETCFG "AppData/Wingoh/data1"))
 (if (= date3 nil)
  (progn
   (setcfg "AppData/Wingoh/data1" a)
   (setcfg "AppData/Wingoh/data2" b)
  )
 )
 (princ)
); WG:acad-cfg


;16-4-05
;
(defun wg:met( / prog$)
 (setq prog$ "met")

; Get plot scale
  (setq skala (wg:GetSkala skala)) ; get plotting scale
  (princ (strcat "\nPlotting scale set to 1 : " (itoa skala)))
; set various global constant values
  (wg:konstant)
  (princ)
);wg:met


;16-4-04
; wg:GetSkala
; Get the plotting scale
(defun wg:GetSkala( skala? / prog$ input?)
  (setq prog$ "GetSkala")
  (initget 6)
  (if (not skala?)
      (setq skala? 1000)
  )
  (setq input? (getint (strcat "\nEnter plotscale : <"
                                 (rtos skala? 2 0) "> ")
  ))

;  (setq input? (dos_getint "PLOTTING SCALE" "Enter scale" 6 skala?))

  (if input?
    (setq skala? input?)
  )
  skala?
);wg:GetSkala

(defun wg:konstant()
 (setq PIon2 (/ pi 2.00000)
       PIon8 (/ pi 8.00000)
       3PIon2 (* 3 PIon2)
       ft ""
       dgt_2 10
       $jft$ 4
       meter 0.3048
       msq "%%200"
       secf1 6 secf2 5.5 secf3 6 b30 nil szero "0" secf4 nil
       szero "0" spbj "" sp "sp" pt "." sp1 ""
       sdeg "%%D" smin "'" ssec "%%034"
 )

  (IF (NOT LINK$)(setq link$ 1.00))
  (IF (NOT LING$)(setq ling$ "m"))
  (IF (NOT DISTFNC)(setq distfnc "m"))

  (if (not tinggi)(setq tinggi 2)) ; text height at any scale
  (setq th (* tinggi (/ skala 1000.0)))
  (if (not dist-decimal)(setq dist-decimal 3)) ; distance decimal
  (if (not htdecimal)(setq htdecimal 3)) ; ht decimal
  (if (not txtsudut)(setq txtsudut 90.0000)); txtsudut
  (if (not brgdist-layer)(setq brgdist-layer "BDLABEL")) ; layer for brg & dist
  (if (not line-layer)(setq line-layer "TRAVLN")) ; layer for lines
  (if (not point-layer)(setq point-layer "TABNO")) ; layer for points.
  (if (not text-layer)(setq text-layer "TABLE")) ; layer for texts.
;brg/dist type
  (if (not type1)
   (progn
    (setq type1 1) ; brg & dist format
    (setq brg-dist-fmt type1)
    (setq brg-dist-fmttype "BG / D")
   )
  ); type1
 (setq brg-dist-fmttype-list (list "None" "BG / D" "D / BG" "BG /" "/ BG" "D /"
  "/ D" "BG,D /" "/ D,BG" "/ BG_D" "BG_D /"))

; brg -accy
 (if (not brg-accy)(setq brg-accy 1))
 (cond
  ((= brg-accy 1)
   (setq brg-accy-num 1)
  )
  ((= brg-accy 10)
   (setq brg-accy-num 2)
  )
  ((= brg-accy 30)
   (setq brg-accy-num 3)
  )
 );cond to control radio button for selection in dcl

(princ "\nAll constants set ....")
;dist function
 (wg:distfunction)
 (princ "\nDist function set ....")
); wg:konstant

;16-4-05
(defun wg:distfunction()
 (if (and (= msq "%%200")(= link$ 1.00))
  (progn
   (setq distfnc "m")
   (setq dist-input-list (list "m" "lg"))
  )
 )

 (if (and (= msq "%%200")(= link$ 0.201168))
  (progn
   (setq dist-input-list (list "m" "lg"))
   (setq distfnc "link")
  )
 )
);wg:distfunction

(defun wg:GetObjectsOnScreen-list ( whatobjects / objects-list obj ssets ss1  prog$ ssobj filter_codelist filter_valuelist filter_code filter_value
)
  (setq    prog$ "wg:GetObjectsOnScreen"
           objects-list nil
           obj nil
  ) ;_ end of setq
   (setq ssets (vla-get-selectionsets ActivedocumentObj))
   (setq ss1 (vlax-make-variant "ss1"))
   (if (vl-catch-all-error-p(vl-catch-all-apply 'vla-item (list ssets ss1)))
    (setq ssobj (vla-add ssets ss1))
    (progn
     (vla-delete(vla-item ssets ss1))
     (setq ssobj(vla-add ssets ss1))
    )
   );if
 (setq filter_codelist (mapcar '(lambda(x) (car x)) whatobjects)
      filter_valuelist (mapcar '(lambda(x) (cdr x)) whatobjects)
      filter_code(vlax-make-safearray
          vlax-vbinteger (cons 0 (1- (length filter_codelist))))
      filter_value(vlax-make-safearray
          vlax-vbvariant (cons 0 (1- (length filter_valuelist))))
 )
(vlax-safearray-fill filter_code filter_codelist)
(vlax-safearray-fill filter_value filter_valuelist)
   (vla-Selectonscreen ssobj filter_code filter_value)
    (if (> (vla-get-count ssobj) 0)
      (progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
 (setq
   obj (vla-item ssobj
 (vlax-make-variant (setq i (1+ i)))
) ;end of vla-item
 ) ;_ end of setq
;  (cond
;    ((vl-position (vlax-get-property obj "ObjectName") whatobjects)
    (setq objects-list
   (append objects-list (list obj))
    ) ;end of setq
;    )
;  ) ;end-of cond
) ;end of repeat
      ) ;end of progn
    ) ;_ end of if
   objects-list
) ;_ wg:GetObjectsOnScreen-list


(defun c:BSP (/ prog$ AllObjects-list)
  (wg:setting)
 ; get only text entities
 (setq   prog$ "BSP"
         AllObjects-list
         (wg:GetObjectsOnScreen-list
;          (list '(-4 . "<OR") '( 0 . "TEXT") '(0 . "LINE") '(-4 . "OR>"))
           (list '( 0 . "TEXT"))
         )
  ) ;_ end of setq
  (if AllObjects-list
    (progn
      (setq n (- 1))
      (repeat (length AllObjects-list)
 (vlax-dump-object (nth (setq n(1+ n)) AllObjects-list) T)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
  (wg:resetting)
  (princ)
) ;_ end of BSP




also Have a look at reworking the location of the error deinition. It is better located as a local function in each of the primary commands.
.. there are several examples of the desirable way to bo this on the site.

Kerry, I don't understand your statement. Could you be kind enough to elaborate and direct me to those examples.

(testing it in an empty drawing actually caused me to shut down AutoCAD by brute force because of the unfortunate loop in wg:GetObject-list).

Stig, I have tested and loaded it in A2k2 & A2K5 in WinXP but do not experience any shut down. I do not have A2K6. That means that there is still some thing wrong somewhere which I cannot pinpoint the error. Could you be kind enough to tell me as to my weakness in my routine.
Thanks all.

csgoh

[Kerry]

I manage to locate the error source and modified it.

and, what did you find .. ?

[SMadsen]

csgoh, I'm not trying to be a pain in the lower back but I'm not going to run through your code step by step.
It simply relies on too many global variables for it to ever work flawlessly and it would take hours to correct it for you.

Here's an example of what I mean: In the very first call to wg:setting, how would you expect the variables current-ucs and current-EXPERT to be assigned any values?
It will immediately trigger an error, which is sent to an error handler that relies on a, at that time, unassigned variable, prog$. Result: a stringp error inside the *error* function.
It's true that an error handler will have access to local variables from the calling function (as I expect the intention would be with prog$) but it should never blindly rely on the value of any passed variable.
In this case, you should make sure that prog$ is assigned a string value:
(and (= (type prog$) 'STR)(princ (strcat "\nPROGRAM - " prog$ ... etc .. ))

You may experience that it works while you are testing it because all global variables will be assigned little by little while testing, thus giving the impression that everything is fine. But testing code also includes running it in a fresh environment from time to time.

[Kerry]

some error routines declared as local :
http://www.theswamp.org/phpBB2/viewtopic.php?p=60291#60291
http://www.theswamp.org/phpBB2/viewtopic.php?p=60762#60762
http://www.theswamp.org/phpBB2/viewtopic.php?p=52864#52864

... and I have a blurb in the 'articles' section at CadVault which may help.

http://www.cadvault.com/forums/article.php?a=38

[Kerry]

Stig, I have tested and loaded it in A2k2 & A2K5 in WinXP but do not experience any shut down.

I did, and it did lock up, so it's not Stigs environment that is at issue.

.. The case is that you have made some assumptions about the system that this will be running on. You aren't the first to do that, and the choices are simple. Either leave it as is, or modify the code to check on the things you are assuming.

Exampes :
What happens if the following do not exist in the drawing, or are not available.
Layers
DimStyles
TextStyles
Linetypes
Linetype definition files
UCS's
etc
etc

[csgoh]

Kerry, Stig;
Thansk for your feedback. Sure appreciate your comments.
There are certains issues in my program whereby I fail to inform you that  the function W2 MUST BE run first  before any other  functions and that I have a wingoh.shx and the linetype file which I have in the support path which you do not have. So in short, my program has some assumptions which Kerry has pointed out correctly. I know my program has many shortcomings but I intend to improve on it and with the help from you guys, I believe that i can further improve on it.
Anyway, thanks guys - you have been a great help.

csgoh

[SMadsen]

Csgoh, that was exactly the point I was trying to make: That there SHOULDN'T be a reason why C:W2 must be run before any other functions.
It should not be necessary for any function or command to wait for global variables to be assigned throughout a network of other functions.

Below is my take on some parts of your program. As implied in the previous post, it would take more time than I have to run through it all so it's not completely waterproof. For example, there are some issues with the settings (seemingly needless multiple settings) but I don't have time to go deeper into it. The important thing is that the use of global variables have been reduced to what they should be used for: settings. They should not be used for passing crucial information around (such as various objects). Handing over that kind of information is done by passing it as arguments.

By the way, you did an excellent job with the wg:GetObjectsOnScreen-list function. Way to go!
The only thing I changed in it was to pass the document object as an argument.

Code below. Please note that it may not be flawless as I don't have more time (gotta catch a train very soon) but look it over for some ideas.

Code: [Select]

;; wg:setting
;; function set variables
(defun wg:setting (/ tmp)
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (setvar "dimzin" 0)
  (setvar "Expert" 4)
  ;;name the current ucs
  (and current-ucs
       (tblsearch "UCS" current-ucs)
       (vl-cmdf "ucs" "s" current-ucs))
  (and global-settings
       (setq tmp (assoc "EXPERT" global-settings))
       (setvar "Expert" (cdr tmp))
  )
  (princ)
) ;_ wg:setting

;;
;; subroutine resetting
;; resets the system to its original values
(defun wg:resetting ()
  (setvar "Expert" 4)
  (cond ((tblsearch "UCS" "wgcurrentucstemp")
         (vl-cmdf "ucs" "r" "wgcurrentucstemp")
         (vl-cmdf "ucs" "d" "wgcurrentucstemp")
        )
  )
  ;; AUTHORS MESSAGE
  (and (= (type prog$) 'STR)
       (princ (strcat "\nProgram New-Wingoh " prog$ " by CS GOH"))
  )
  (and global-settings
      (foreach setting global-settings
        (setvar (car setting) (cdr setting)))
  )
  ;; ^This could throw an error if e.g. the textstyle
  ;; has been purged in the meanwhile but let's take
  ;; that chance

) ;_ wg:resetting


;; set units to meters
;; sets direction to north and clockwise
(defun WG:setunits ()
  (setvar "lunits" 2)                   ; units to meters
  (setvar "luprec" 4)                   ; 4 decimal precision
  (setvar "aunits" 1)                   ; angular units to dms
  (setvar "auprec" 3)                   ; precision 10d10'10"
  (if (and (/= (getvar "ANGBASE") (/ pi 2))
           (/= (getvar "ANGDIR") 1)
      )
    (progn
      (setvar "angbase" (/ pi 2))
      (setvar "angdir" 1)
    )
  )
) ;_ WG:setunits


;;C:W2
;; function to get system variables
(defun c:w2 (/ *error* prog$ acadObj ActivedocumentObj modelspaceObj)
  (defun *error* (s)
    (if (= (type prog$) 'STR)
      (if (or (= s "Function cancelled") (= s "quit / exit abort"))
        (princ
          (strcat "\nPROGRAM - " prog$ " Cancelled/quit/abort ")
        )
        (progn
          (princ (strcat "\nPROGRAM - " prog$ " Error: " s))
          (princ)
        )
      )
    ) ;_ if
    (if (wg:resetting)
      (princ "\nSYSTEM VARIABLES have been reset\n")
    )
    (princ)
  )
  (setq prog$ "W2")
  ;;global names
  (vl-load-com)
  (setq acadObj           (vlax-get-acad-object)
        ;; acad Object
        ActivedocumentObj (vla-get-Activedocument acadObj)
        ;; the current dwg
        modelspaceObj     (vla-get-modelspace ActivedocumentObj)
                          ;; the modelspace
  )
  (setq current-ucs "wgcurrentucstemp")
  ;; CURRENT SYSTEM VARIABLES
  (setq global-settings nil)
  (foreach var '("EXPERT"      "CLAYER"      "CMDECHO"
                 "BLIPMODE"    "TEXTSTYLE"   "OSMODE"
                 "DIMZIN"
                )
    (setq global-settings
           (cons (cons var (getvar var)) global-settings)
    )
  )

  (WG:load-new-linetypes ActivedocumentObj)
  (WG:create-layers ActivedocumentObj)
  (WG:create-textstyles ActivedocumentObj)
  (WG:acad-cfg)
  ;; cfg file
  (wg:setting)

  ;;set units,meters,clockwise
  (WG:setunits)
  ;;plot scale,th,etc
  (wg:met)
  (princ)
) ;_ w2


;; wg:makela
(defun WG:makela (layer objLayers / prog$ lan2)
  (setq prog$ "WG:makela")
  (setq lan2 (vl-catch-all-apply 'vla-add (list objLayers (car layer))))
  (if (not (vl-catch-all-error-p lan2))
    (progn
      (vla-put-color lan2 (cadr layer))
      ;; setting the linetype can fail if linetype is not loaded
      (vl-catch-all-apply 'vla-put-linetype (list lan2 (caddr layer)))
      (princ (strcat "\nLayer " (car layer) " created ...."))
    )
  ) ;_if
)

;; wg:activate-layer
;; function to turn on, thaw and unlock if layers exist.
(defun WG:activate-layer (lan1 objLayers / prog$ layer)
  (setq prog$ "WG:activate-layer")
  (cond ((not (vl-catch-all-error-p (setq layer (vl-catch-all-apply 'vla-item (list objLayers lan1)))))
         (vla-put-Freeze layer ':vlax-false)
         (vla-put-Layeron layer ':vlax-true)
         (vla-put-Lock layer ':vlax-false)
         (princ (strcat "\nLayer " lan1 " on,thawed & unlocked ....")
         )
        )
  )
) ;_WG:activate-layer

;; 13-4-05
;; create the nine layers
(defun WG:create-layers (ActivedocumentObj / prog$ objLayers layerlist)
  (setq prog$ "WG:create-layers")
  (setq objLayers (vla-get-layers ActivedocumentObj)
        layerlist (WG:GetName-any-type objLayers)
  )
  (foreach layer '(("BGDIST" 7 "CONTINUOUS")
                   ("BLUELN" 5 "DASHED")
                   ("LOTARE" 7 "CONTINUOUS")
                   ("GRIDTXT" 7 "CONTINUOUS")
                   ("TRAVLN" 9 "CONTINUOUS")
                   ("TABLE" 7 "CONTINUOUS")
                   ("TABNO" 7 "CONTINUOUS")
                   ("BDLABEL" 7 "CONTINUOUS")
                   ("BLUETX" 5 "CONTINUOUS")
                  )
    (if (not (member (car layer) layerlist))
      (wg:makela layer objLayers)
      (wg:activate-layer lan objLayers)
    )
  )
  (princ)
)

;;13-4-05
;;Function to get names of all layers,linetypes or textstyles and put into list
(defun WG:GetName-any-type (obj? / prog$ name? theList)
  (setq prog$ "WG:GetName-any-type")
  (vlax-for each-item obj?
    (setq name?   (strcase (vla-get-name each-item))
          theList (cons name? theList)
    )
  ) ;_vlax-for
  thelist
) ;_WG:GetName-any-type


;;13-4-05
;;create new  textstyles
;;make WG1 & W785 textstyle if absent
(defun WG:Create-textstyles (ActivedocumentObj / prog$ anewTxtstyle objTextstyles textstyleList str)
  (setq prog$ "WG:Create-textstyles")
  (setq objTextstyles (vla-get-Textstyles ActivedocumentObj)
        textstylelist (WG:GetName-any-type objTextstyles)
        str ""
  )
  (foreach style '(("W785" "SIMPLEX.SHX" 0.785)
                   ("WG1" "WINGOH.SHX" 0.785)
                  )
    (if (not (member (car style) textstylelist))
      (if (not (vl-catch-all-error-p
                 (setq anewTxtstyle
                        (vl-catch-all-apply
                          'vla-add
                          (list objTextstyles (car style))
                        )
                 )
               )
          )
        (progn
          (if (vl-catch-all-error-p
                (vl-catch-all-apply
                  'vla-put-fontFile
                  (list anewTxtstyle (cadr style))
                )
              )
            (setq str " (using standard font file)")
          )
          (vla-put-width anewTxtstyle (caddr style))
          (princ (strcat "\nTextstyle " (car style) " created" str))
        )
        (princ
          (strcat "\nTextstyle " (car style) " could not be created")
        )
      )
      (princ (strcat "\nTextstyle " (car style) " already exists")
      )
    )
  )
)


;;13-4-05
;; load linetypes
(defun WG:load-new-linetypes
       (ActivedocumentObj / prog$ objLinetypes linetypelist)
  (setq prog$ "WG:load-new-linetypes")
  (setq objLinetypes (vla-Get-Linetypes ActivedocumentObj)
        linetypelist (WG:GetName-any-type objLinetypes)
  )
  (cond
    ((or (setq fn (findfile "C:/GOH/ACAR14/WINGOH.lin"))
         (setq fn (getfiled "Select linetype file" "C:\\" "lin" 8))
     )
     (foreach ltype '("DASHED"         "BARBWIRE"
                      "BARBWIRE2"      "BARBWIREX2"
                      "CHAINLINK"      "CHAINLINK2"
                      "CHAINLINKX2"
                     )
       (if (not (member ltype linetypelist))
         (if
           (vl-catch-all-error-p
             (vl-catch-all-apply 'vla-load (list objLinetypes ltype fn))
           )
            (princ (strcat "\n" ltype " linetype could not be loaded"))
            (princ (strcat "\n" ltype " linetype loaded"))
         )
         (princ (strcat "\n" ltype " exists already"))
       )
     )
    )
    ((princ "\nCould not load linetype definition file"))
  )
)

;;; ----- wg:met, wg:getSkala etc .. left out

(defun wg:GetObjectsOnScreen-list (ActivedocumentObj whatobjects /
                                   objects-list   obj
                                   ssets          ss1
                                   prog$          ssobj
                                   filter_codelist
                                   filter_valuelist
                                   filter_code    filter_value
                                  )
  (setq prog$        "wg:GetObjectsOnScreen"
        objects-list nil
        obj          nil
  ) ;_ end of setq
  (setq ssets (vla-get-selectionsets ActivedocumentObj))
  (setq ss1 (vlax-make-variant "ss1"))
  (if (vl-catch-all-error-p
        (vl-catch-all-apply 'vla-item (list ssets ss1))
      )
    (setq ssobj (vla-add ssets ss1))
    (progn
      (vla-delete (vla-item ssets ss1))
      (setq ssobj (vla-add ssets ss1))
    )
  ) ;_if
  (setq filter_codelist  (mapcar '(lambda (x) (car x)) whatobjects)
        filter_valuelist (mapcar '(lambda (x) (cdr x)) whatobjects)
        filter_code      (vlax-make-safearray
                           vlax-vbinteger
                           (cons 0 (1- (length filter_codelist)))
                         )
        filter_value     (vlax-make-safearray
                           vlax-vbvariant
                           (cons 0 (1- (length filter_valuelist)))
                         )
  )
  (vlax-safearray-fill filter_code filter_codelist)
  (vlax-safearray-fill filter_value filter_valuelist)
  (vla-Selectonscreen ssobj filter_code filter_value)
  (if (> (vla-get-count ssobj) 0)
    (progn
      (setq no-ent nil)
      (setq i (- 1))
      (repeat (vla-get-count ssobj)
        (setq
          obj (vla-item ssobj
                        (vlax-make-variant (setq i (1+ i)))
              )                         ;end of vla-item
        ) ;_ end of setq
        ;;     (cond
        ;;       ((vl-position (vlax-get-property obj "ObjectName") whatobjects)
        (setq objects-list
               (append objects-list (list obj))
        )                               ;end of setq
        ;;       )
        ;;     ) ;end-of cond
      )                                 ;end of repeat
    )                                   ;end of progn
  ) ;_ end of if
  objects-list
) ;_ wg:GetObjectsOnScreen-list


(defun c:BSP (/ prog$ AllObjects-list ActivedocumentObj)
  (wg:setting)
  ;; get only text entities
  (setq prog$ "BSP"
        ActivedocumentObj (vla-get-activedocument (vlax-get-acad-object))
        AllObjects-list
         (wg:GetObjectsOnScreen-list ActivedocumentObj
           ;;          (list '(-4 . "<OR") '( 0 . "TEXT") '(0 . "LINE") '(-4 . "OR>"))
           (list '(0 . "TEXT"))
         )
  ) ;_ end of setq
  (if AllObjects-list
    (progn
      (setq n (- 1))
      (repeat (length AllObjects-list)
        (vlax-dump-object (nth (setq n (1+ n)) AllObjects-list) T)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
  (wg:resetting)
  (princ)
) ;_ end of BSP


[csgoh]

Thanks, Stig.
 Sure keep those global variables in mind in my future routines.
Will look at your codes ASAP and get some pointers from there.
And a very BIG THANK YOU to you & Kerry.
csgoh