Topic: What wrong in this Lisp?

[csgoh]

I have this lisp and it gives me this error code "error: bad argument type: stringp #<VLA_OBJECT IcadLayer 01076ac47).
I have traced this error to the line (vla-put-linetype lan lalt) in the WG:makela routine. What's wrong here? Pls help.
Also how can I load linetypes using the ActiveX / Visual Lisp method instead of using the command linetype method.
Thanks

csgoh

Code: [Select]


; wg:setting
;
(defun wg:setting ()
 (setq oerr *error*               ;save *error*
       *error* 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)
 (princ)
 (setq *error* oerr)    ;RESET ERROR
; AUTHORS MESSAGE
 (princ (strcat "\nProgram New-Wingoh " prog$ " by CS GOH"))
 (princ)
); wg:resetting
 
;
;ERROR TRAP
;
(defun 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)
); 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 "DIMZIM")
       current-EXPERT (getvar "EXPERT") ; CURRENT SYSTEM VARIALBES
 )
 (WG:load-new-linetypes)
 (WG:create-layers)
;       (WG:get-all-textstyles)
;       (WG:get-all-layers)

 (wg:setting)

; to unremark for demo
; (demolsp)
;

;set units,meters,clockwise
 (WG:setunits)
 (princ)
; (met)
 (princ)
); w2

(defun WG:makela(lan lac lalt / prog$)
 (setq prog$ "WG:makela")
 (setq lan (vl-catch-all-apply 'vla-add (list objLayers lan)))
 (if (not (vl-catch-all-error-p lan))
  (progn
   (vla-put-color lan lac)
;what is wrong here?
 (print "error here")
  (vla-put-linetype lan lalt)
    (princ (strcat "\nLayer " lan " created ...."))
  )
;  (progn
;   (print "here1")
;    nil
;  )
 );if
);WG:makela

;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))
 (setq layerlist (WG:Get-all-layers))

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


;13-4-05
;get all layers
(defun WG:Get-all-layers(
/ prog$ layername thelist
)
  (setq prog$ "WG:Get-All-Layers")
  (setq thelist '())
  (vlax-for each-layer objLayers
    (setq layername (strcase (vla-get-name each-layer))
   theList (cons layername theList)
    )
  );vlax-for
 thelist
);WG:Get-All-Layers


;13-4-05
;get all textstyles
;make WG1 & W785 textstyle if absent
(defun WG:Get-all-textstyles(
/ progName txtList txtname anewTxtstyle objTextstyles
)
  (setq progName "WG:Get-All-textstyles")
  (setq objTextstyles (vla-get-Textstyles ActivedocumentObj))
  (setq txtList '())
  (vlax-for each-textstyle objTextstyles
   (setq  txtname (strcase (vla-get-name each-textstyle))
          txtList (cons txtname txtList)
   )
);vlax-for
  (if (not (member "W785" txtlist))
   (progn
    (setq anewTxtstyle(vla-add objTextstyles "W785"))
    (vla-put-fontFile anewTxtstyle "SIMPLEX.SHX")
    (vla-put-width anewTxtstyle 0.785)
   )
  );if
  (if (not (member "WG1" txtlist))
   (progn
    (setq anewTxtstyle(vla-add objTextstyles "WG1"))
    (vla-put-fontFile anewTxtstyle "WINGOH.SHX")
    (vla-put-width anewTxtstyle 0.785)
   )
  );if
);WG:Get-All-Textstyles


;13-4-05
; load linetypes
(defun WG:load-new-linetypes( / prog$)
 (setq prog$ "WG:load-new-linetypes")
 (setvar "Expert" 3)
 (command "._linetype" "_load" "DASHED" "C:/GOH/ACADR14/WINGOH" "")
 (command "._linetype" "_load" "BARBWIRE" "C:/GOH/ACADR14/WINGOH" "")
 (command "._linetype" "_load" "BARBWIRE2" "C:/GOH/ACADR14/WINGOH" "")
 (command "._linetype" "_load" "BARBWIREX2" "C:/GOH/ACADR14/WINGOH" "")
 (command "._linetype" "_load" "CHAINLINK" "C:/GOH/ACADR14/WINGOH" "")
 (command "._linetype" "_load" "CHAINLINK2" "C:/GOH/ACADR14/WINGOH" "")
 (command "._linetype" "_load" "CHAINLINKX2" "C:/GOH/ACADR14/WINGOH" "")
 (setvar "Expert" current-EXPERT)
 (princ)
)


[csgoh]

Found my mistake in the routine. It's the
(princ (strcat "\nLayer " lan " created ....")) line whcih is causing the problem. The variable lan is an object rather than a STR. Anyway, thanks.

csgoh

[SMadsen]

The stringp error happens when you pass a layer object to a STRCAT function. In WG:makela, change this line:
(princ (strcat "\nLayer " lan " created ...."))

to

(princ (strcat "\nLayer " (vla-get-name lan) " created ...."))

I get other errors when running your code that come from nil values for lalt in WG:makela.

Loading linetypes with ActiveX is very easy. Just grab the doc's ltype collection and pass it to VLA-LOAD (or similar) along with the linetype name and the .lin file you wish to load from:

(vla-load ltype-collection ltype-name ltype-filename)

[SMadsen]

Oh good, you found it.

[SMadsen]

Example of using the Load method:

Code: [Select]

(defun WG:load-new-linetypes (fname / prog$ doc ltypes)
  (setq prog$ "WG:load-new-linetypes")
  (setq doc    (vla-get-activedocument (vlax-get-acad-object))
        ltypes (vla-get-linetypes doc)
  )
  (cond ((setq fn (findfile fname))
         (foreach ltype '("DASHED"         "BARBWIRE"
                          "BARBWIRE2"      "BARBWIREX2"
                          "CHAINLINK"      "CHAINLINK2"
                          "CHAINLINKX2"
                         )
           (if (vl-catch-all-error-p
                 (vl-catch-all-apply 'vla-load (list ltypes ltype fn)))
             (princ (strcat "\n" ltype " not found")))
         )
        )
  )
)

*edited* ohh waste of time .. you already got all that from AUGI

[Kerry]

There's nothing like a bit of competition to get the code flowing Stig

added : Smiley, just so there's no confusion that the statement was ridiculous.

[SMadsen]

Heh. But it does make you go "arghhh!" ..

[daron]

csgoh, Did you write that code?

[csgoh]

Daron;
Yeah, I wrote those codes. Is there anything wrong with it? I started learning writing Autolisp some 2 years back and now and migrating to Visual Lisp/ActiveX. I have learnt a fair bit from this forum and AUGI and would like to thank you guys for all the help. As you can see, most of my questions are more inclined to the Visual Lisp/ActiveX and I appreciate the tremendous support from you guys.

csgoh.

[daron]

If it works, I suppose there's nothing wrong with it. I just thought it seemed a little long in the tooth and could use some refinements. You have a long list of functions that have basically the same information.

One question I have is what is the purpose of all the strings of the name of your functions:

Code: [Select]

(setq prog$ "WG:Get-All-Layers")


[csgoh]

If it works, I suppose there's nothing wrong with it. I just thought it seemed a little long in the tooth and could use some refinements. You have a long list of functions that have basically the same information

Could you elaborate whcih section of my codes that need to be fien tuned?
The purpose of all the strings of the name of the function is just to inform the user that he has cancellled the routine.

csgoh

[daron]

For starters:

Code: [Select]


(defun WG:makela(lan lac lalt / prog$)
 (setq prog$ "WG:makela")
  (if (not (member lan layerlist))
      (progn
 (setq lan (vl-catch-all-apply 'vla-add (list objLayers lan)))
 (if (not (vl-catch-all-error-p lan))
  (progn
   (vla-put-color lan lac)
;what is wrong here?
 (print "error here")
  (vla-put-linetype lan lalt)
    (princ (strcat "\nLayer " lan " created ...."))
  )
;  (progn
;   (print "here1")
;    nil
;  )
 );if
 )
);WG:makela

;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))
 (setq layerlist (WG:Get-all-layers))

 (wg:makela "BGDIST" 1 "CONTINUOUS")
 (wg:makela "BLUELN" 5 "DASHED")
 (wg:makela "LOTARE" 7 "CONTINUOUS")
 (wg:makela "GRIDTXT" 7 "CONTINUOUS")
 (wg:makela "TRAVLN" 9 "CONTINUOUS")
 (wg:makela "TABLE" 7 "CONTINUOUS")
 (wg:makela "TABNO" 7 "CONTINUOUS")
 (wg:makela "BDLABEL" 7 "CONTINUOUS")
 (wg:makela "BLUETX" 5 "CONTINUOUS")
 (princ)
);WG:create-layers
and this:

Code: [Select]


(defun dlibck (file)
     (if (not (member file (arx)))
 (if (findfile file)
      (progn
   (arxload file)
   (princ (strcat "\n" file " already loaded"))
      )
 )
 (princ (strcat "\n" file " loaded"))
     )
)
;doslib loading

(defun c:dblip ()
 ; Check for AutoCAD 2000, 2000i, or 2002
     (cond ((= "15" (substr (getvar "acadver") 1 2))
   (dlibck "doslib15.arx")
  )
  ((= "16" (substr (getvar "acadver") 1 2))
   (dlibck "doslib16.arx")
  )
     )
)
(c:dblip)

I can't test any of this, but it could shorten your code a bit.

[csgoh]

Daron,
That would overwrite the linetypes should the user change.
The doslib are the freewares from www.mcneel.com. Kind of useful and check it out if you like. Any way, thanks for all the help and support.

csgoh