PDA

View Full Version : What's wrong in this Lisp



csgohjmj
2005-04-14, 03:06 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


;
; 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)
)

RobertB
2005-04-14, 05:45 AM
You must have a bad string for the linetype variable.
You use the Load method to load a linetype.

(defun C:Test (/ myDoc myLayer)
(vl-Load-Com)
(setq myDoc (vla-Get-Activedocument (vlax-Get-Acad-Object)))
(vla-Load (vla-Get-Linetypes myDoc) "Hidden" "Acad.lin")
(setq myLayer (vla-Add (vla-Get-Layers myDoc) "Test"))
(vla-Put-Linetype myLayer "Hidden")
(princ))

csgohjmj
2005-04-14, 06:19 AM
Hi Robert;
I have a variable name lalt for the linetype and set it to "CONTINUOUS" or "DASHED". Is this wrong? Looking at the code, I can't understand where I have gone wrong? I have also loaded the linetypes using the command "linetype". I am using acad2002. An extract of the lisp file here.

csgoh



;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

(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

csgohjmj
2005-04-14, 08:02 AM
Found my mistake in the routine. It's the
(princ (strcat "\nLayer " lan " created ....")) line whcih is causing. The variable lan is an object rather than a STR. Anyway, thanks Robert.

csgoh