Author Topic: What wrong in this Lisp?  (Read 3701 times)

0 Members and 1 Guest are viewing this topic.

csgoh

  • Newt
  • Posts: 176
What wrong in this Lisp?
« on: April 14, 2005, 03:00:45 AM »
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

  • Newt
  • Posts: 176
What wrong in this Lisp?
« Reply #1 on: April 14, 2005, 04:07:14 AM »
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

  • Guest
What wrong in this Lisp?
« Reply #2 on: April 14, 2005, 04:20:37 AM »
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

  • Guest
What wrong in this Lisp?
« Reply #3 on: April 14, 2005, 04:21:15 AM »
Oh good, you found it.

SMadsen

  • Guest
What wrong in this Lisp?
« Reply #4 on: April 14, 2005, 04:29:37 AM »
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

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
What wrong in this Lisp?
« Reply #5 on: April 14, 2005, 04:59:28 AM »
There's nothing like a bit of competition to get the code flowing Stig :D

added : Smiley, just so there's no confusion that the statement was ridiculous.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

SMadsen

  • Guest
What wrong in this Lisp?
« Reply #6 on: April 14, 2005, 06:55:03 AM »
Heh. But it does make you go "arghhh!" ..

daron

  • Guest
What wrong in this Lisp?
« Reply #7 on: April 14, 2005, 07:52:41 AM »
csgoh, Did you write that code?

csgoh

  • Newt
  • Posts: 176
What wrong in this Lisp?
« Reply #8 on: April 15, 2005, 10:50:42 PM »
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

  • Guest
What wrong in this Lisp?
« Reply #9 on: April 18, 2005, 08:08:29 AM »
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

  • Newt
  • Posts: 176
What wrong in this Lisp?
« Reply #10 on: April 18, 2005, 07:44:02 PM »
Quote

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

  • Guest
What wrong in this Lisp?
« Reply #11 on: April 19, 2005, 08:00:37 AM »
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

  • Newt
  • Posts: 176
What wrong in this Lisp?
« Reply #12 on: April 25, 2005, 12:09:02 AM »
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