TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: HasanCAD on July 19, 2017, 01:19:52 PM

Title: When run line by line works good but the routine gives error
Post by: HasanCAD on July 19, 2017, 01:19:52 PM
The error
Code - Auto/Visual Lisp: [Select]
  1. Select Level:
  2. Error: bad argument type: lentityp nil

The code
Code - Auto/Visual Lisp: [Select]
  1. (defun c:gts ( /
  2.               ang cly cmd dyn-mode dyp
  3.               fs-att fs-blck fsblock lvl lvlget lyr objblk objinsp objstrng
  4.               objvl-strng os-mode r-ang
  5.               sl-att sl-blck slblock slp slpdist slpdist-mid spc trgtlvl trgtpnt typ
  6.               )  
  7.   (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
  8.   (setq cly (getvar "CLAYER"))
  9.   (LM:startundo (LM:acdoc))
  10.  
  11.     (foreach args '(
  12.                   ("L-LVL-FNSH" 6 "Continuous" 0.15 t 0 "FINISH SURFACE")
  13.                   ("Welcome to CAP" 7 "Continuous" 0 nil 0 "Welcome to CAP Layer for non printable objects")
  14.                   ) (apply 'lyrmk args))
  15.   (setq clyr (getvar "CLAYER"))
  16.   (setvar "CLAYER" "Welcome to CAP")
  17.  
  18.   (if (and
  19.       (vl-cmdf "_.-insert" (strcat "X:/AutoCAD/LAND/Blocks/" "CAP_L_FNSH_SRFC_DB" ".dwg" ) "0,0,0" "1" "1" "0")         ; insert block
  20.       (setq sset1 (ssget "x" (list (cons 0 "INSERT") (cons 2 "CAP_L_FNSH_SRFC_DB"))))
  21.       (vl-cmdf "_.-insert" (strcat "X:/AutoCAD/LAND/Blocks/" "CAP_L_SLP_LVL_DB" ".dwg" ) "0,0,0" "1" "1" "0")           ; insert block
  22.       (setq sset2 (ssget "x" (list (cons 0 "INSERT") (cons 2 "CAP_L_SLP_LVL_DB"))))
  23.       )
  24.     (progn
  25.       (vl-cmdf "_.erase" sset1 "")
  26.       (vl-cmdf "_.-purge" "blocks" "CAP_L_FNSH_SRFC_DB" "n")
  27.       (vl-cmdf "_.erase" sset2 "")
  28.       (vl-cmdf "_.-purge" "blocks" "CAP_L_SLP_LVL_DB" "n")
  29.       (setvar "CLAYER" clyr)
  30.       (vl-cmdf "_.-purge" "layers" "Welcome to CAP" "n")
  31.       ))
  32.  
  33.   (setq os-mode         (getvar "osmode")       )  
  34.   (setq dyn-mode        (getvar "dynmode")      )       (setvar "dynmode" 1     )
  35.   (setq dyp             (getvar "dynprompt")    )       (setvar "dynprompt" 1   )
  36.   (setq cmd             (getvar "cmdecho")      )       (setvar "cmdecho" 0     )
  37.  
  38.   (setvar       "clayer" "L-LVL-FNSH"   )
  39.   (setq FS-blck "CAP-L-FNSH-SRFC-DB"    )
  40.   (setq FS-att  "ELE"                   )
  41.   (setq SL-blck "CAP-L-SLP-LVL-DB"      )
  42.   (setq SL-att  "SLOPE"                 )
  43.   (setq lyr     "L-LVL-FNSH"            )
  44.  
  45.   (if
  46.     (and
  47.       (setq lvl (car (nentsel "\nSelect Level: ")))
  48.       (setq lvlget (entget lvl))
  49.       (setq typ  (cdr (assoc 0 lvlget)))
  50.       )
  51.     (progn
  52.       (cond
  53.         ( (eq typ "MTEXT")
  54.           (and
  55.             (setq objstrng (cdr (assoc  1 lvlget)))
  56.             (setq objinsp  (cdr (assoc 10 lvlget)))  ))
  57.         ( (eq typ "TEXT")
  58.           (and
  59.             (setq objstrng (cdr (assoc  1 lvlget)))
  60.             (setq objinsp  (cdr (assoc 10 lvlget)))  ))
  61.         ( (eq typ "ATTDEF")
  62.           (and
  63.             (setq objstrng (cdr (assoc  2 lvlget)))
  64.             (setq objinsp  (cdr (assoc 11 lvlget)))  ))
  65.         ( (eq typ "MULTILEADER")
  66.           (and
  67.             (setq objstrng (cdr (assoc 304 lvlget)))
  68.             (setq objinsp  (cdr (assoc 110 lvlget))) ))
  69.         ( (eq typ "ATTRIB")
  70.           (and
  71.             (setq objstrng (cdr (assoc   1 lvlget)))
  72.             (setq objinsp  (cdr (assoc 10 (entget objblk)))) ; block insertion point
  73.             ))
  74.         ); cond
  75.  
  76.       (if (LM:parsenumbers objstrng)
  77.         (setq objstrng (nth 0 (LM:parsenumbers objstrng)))
  78.         (setq objstrng 0.000)
  79.         )
  80.       (setq objblk   (cdr (assoc 330 lvlget)))
  81.  
  82.       (setq TrgtPnt (getpoint objinsp "\nSelect target point")) ; target point
  83.       (setq Slpdist (distance objinsp TrgtPnt))
  84.       (setq ang (angle objinsp TrgtPnt))
  85.       (setq R-ang (LM:readable ang))      
  86.       (setq Slpdist-mid (vlax-3D-point (polar objinsp ang (/ Slpdist 2.0))))
  87.  
  88.       (setq Slp  (cond ( (getreal (strcat "\nWhat is Slope < " (rtos (setq Slp  (cond ( Slp  ) ( 3.000 ))) 2 3) " >?: "))) ( Slp )))
  89.      
  90.       (setq Trgtlvl (rtos (atof (rtos (+ (/ (* Slpdist Slp) 100) objstrng ) 2 3))2 3))
  91.       (setq FSblock (vla-InsertBlock spc (vlax-3D-point TrgtPnt) FS-blck 1. 1. 1. 0.))
  92.       (LM:vl-setattributevalue FSblock FS-att (strcat "F.S: " Trgtlvl))
  93.       (vla-put-layer FSblock lyr)
  94.      
  95.       (setq SLblock (vla-InsertBlock spc Slpdist-mid SL-blck 1. 1. 1. R-ang))
  96.       (LM:vl-setattributevalue SLblock SL-att (strcat "S= " (rtos (abs Slp)2 3) "%"))
  97.       (vla-put-layer SLblock lyr)
  98.      
  99.       ;(if (< 0 Slp) (LM:setdynpropvalue SLblock "FlipV" 0) (LM:setdynpropvalue SLblock "FlipV" 1))
  100.       ;(if (<= (nth 0 objinsp) (nth 0 TrgtPnt)) (LM:setdynpropvalue SLblock "FlipV" 1) (LM:setdynpropvalue SLblock "FlipV" 0))
  101.       (while
  102.         (setq objinsp TrgtPnt)
  103.         (setq TrgtPnt (getpoint objinsp "\nSelect target point"))
  104.         (setq Slpdist (distance objinsp TrgtPnt))
  105.         (setq ang (angle objinsp TrgtPnt))
  106.         (setq R-ang (LM:readable ang))
  107.         (setq Slpdist-mid (vlax-3D-point (polar objinsp ang (/ Slpdist 2.0))))
  108.         (setq objVL-Strng (LM:vl-getattributevalue FSblock FS-att))
  109.         (setq objstrng (nth 0 (LM:parsenumbers objVL-Strng)))
  110.         (setq Slp (cond ( (getreal (strcat "\nWhat is Slop < " (rtos (setq Slp  (cond ( Slp  ) ( 3.00 ))) 2 3) " >?: "))) ( Slp )))
  111.         (setq Trgtlvl (rtos (atof (rtos (+ (/ (* Slpdist Slp) 100) objstrng) 2 3))2 3))
  112.         (setq FSblock (vla-InsertBlock spc (vlax-3D-point TrgtPnt) FS-blck 1. 1. 1. 0.))
  113.         (LM:vl-setattributevalue FSblock FS-att (strcat "F.S: " Trgtlvl))
  114.         (vla-put-layer FSblock lyr)
  115.        
  116.         (setq SLblock (vla-InsertBlock spc Slpdist-mid SL-blck 1. 1. 1. R-ang))
  117.         (LM:vl-setattributevalue SLblock SL-att (strcat "S= " (rtos (abs Slp)2 3) "%"))
  118.         (vla-put-layer FSblock lyr)
  119.        
  120.         ;(if (< 0 Slp) (LM:setdynpropvalue SLblock "FlipV" 0) (LM:setdynpropvalue SLblock "FlipV" 1))
  121.         ;(if (<= (nth 0 objinsp) (nth 0 TrgtPnt)) (LM:setdynpropvalue SLblock "FlipV" 1) (LM:setdynpropvalue SLblock "FlipV" 0))
  122.         ) ;while
  123.       ) ;progn
  124.     (princ "\nPlease select correct level")
  125.     ) ;if
  126.   (setvar "CLAYER" cly)
  127.   (LM:endundo (LM:acdoc))
  128.   ) ; defun

Subroutines
Code - Auto/Visual Lisp: [Select]
  1. (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg))) (princ))
  2.  
  3. ;; Parse Numbers  -  Lee Mac
  4. ;; Parses a list of numerical values from a supplied string.
  5. (defun LM:parsenumbers ( str ) ((lambda ( l ) (read (strcat "(" (vl-list->string (mapcar '(lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58))) b 32)) (cons nil l) l (append (cdr l) '(())))) ")" ))) (vl-string->list str)))
  6.  
  7. ;; Set Dynamic Block Property Value  -  Lee Mac
  8. ;; Modifies the value of a Dynamic Block property (if present)
  9. ;; blk - [vla] VLA Dynamic Block Reference object
  10. ;; prp - [str] Dynamic Block property name (case-insensitive)
  11. ;; val - [any] New value for property
  12. ;; Returns: [any] New value if successful, else nil
  13. (defun LM:setdynpropvalue ( blk prp val ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (progn (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x)))) (cond (val) (t))))) (vlax-invoke blk 'getdynamicblockproperties)))
  14.  
  15. ;; Start Undo  -  Lee Mac
  16. ;; Opens an Undo Group.
  17. (defun LM:startundo ( doc )    (LM:endundo doc)    (vla-startundomark doc))
  18.  
  19. ;; End Undo  -  Lee Mac
  20. ;; Closes an Undo Group.
  21. (defun LM:endundo ( doc )    (while (= 8 (logand 8 (getvar 'undoctl)))        (vla-endundomark doc)    ))
  22.  
  23. ;; Readable  -  Lee Mac
  24. ;; Returns an angle corrected for text readability.
  25. (defun LM:readable ( a ) ((lambda ( a ) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (LM:readable (+ a pi)) a)) (rem (+ a pi pi) (+ pi pi))))
  26.  
  27. ;; Get Attribute Value  -  Lee Mac
  28. ;; Returns the value held by the specified tag within the supplied block, if present.
  29. ;; blk - [vla] VLA Block Reference Object
  30. ;; tag - [str] Attribute TagString
  31. ;; Returns: [str] Attribute value, else nil if tag is not found.
  32. (defun LM:vl-getattributevalue ( blk tag )    (setq tag (strcase tag))    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att)))        (vlax-invoke blk 'getattributes)    ))
  33.  
  34. ;; Set Attribute Value  -  Lee Mac
  35. ;; Sets the value of the first attribute with the given tag found within the block, if present.
  36. ;; blk - [vla] VLA Block Reference Object
  37. ;; tag - [str] Attribute TagString
  38. ;; val - [str] Attribute Value
  39. ;; Returns: [str] Attribute value if successful, else nil.
  40. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val)))(vlax-invoke blk 'getattributes)))
  41.  
  42. ;; Active Document  -  Lee Mac
  43. ;; Returns the VLA Active Document Object
  44. (defun LM:acdoc nil    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))    (LM:acdoc))
  45.  
  46. (defun lyrmk (Nme Col lTyp lWgt Plt trns dsc / lay lyrs cmd) ;lee mac
  47.   ;http://www.cadtutor.net/forum/showthread.php?36882-Check-create-layer-issue-in-Lisp&p=243520&viewfull=1#post243520
  48.   (setq cmd (getvar 'cmdecho))
  49.   (setvar 'cmdecho 0)  
  50.   (if (not (tblsearch "LAYER" Nme))
  51.     (progn
  52.       (setq lay (vla-add lyrs Nme))
  53.       ;(mdfy)
  54.         (setq entVL (vlax-ename->vla-object (tblobjname "LAYER" Nme)))
  55.       (and Col (vla-put-Color entVL Col))
  56.       (and lTyp (lTload lTyp) (vla-put-Linetype entVL lTyp))
  57.       ;  (and lWgt (vla-put-LineWeight entVL (eval (read (strcat "acLnWt" lWgt)))))
  58.       (and lWgt (vl-cmdf "_.-layer" "_LWeight" lWgt Nme ""))
  59.       (and (not Plt) (vla-put-Plottable entVL :vlax-false))
  60.       (and (setq LyrDs (vlax-put-property entVL 'Description dsc)))
  61.       (vl-cmdf "_.-layer" "_TR" trns Nme "")
  62.       )
  63.     (progn
  64.       ;(mdfy)
  65.       (setq entVL (vlax-ename->vla-object (tblobjname "LAYER" Nme)))
  66.       (and Col (vla-put-Color entVL Col))
  67.       (and lTyp (lTload lTyp) (vla-put-Linetype entVL lTyp))
  68.       ;  (and lWgt (vla-put-LineWeight entVL (eval (read (strcat "acLnWt" lWgt)))))
  69.       (and lWgt (vl-cmdf "_.-layer" "_LWeight" lWgt Nme ""))
  70.       (and (not Plt) (vla-put-Plottable entVL :vlax-false))
  71.       (and (setq LyrDs (vlax-put-property entVL 'Description dsc)))
  72.       (vl-cmdf "_.-layer" "_TR" trns Nme "")))
  73.   (setvar 'cmdecho cmd))
  74.  
  75. (defun lTload   (lTyp) (or (tblsearch "LTYPE" lTyp) (vla-load   (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))) lTyp "acad.lin")))
  76.  

Thanks for help
Title: Re: When run line by line works good but the routine gives error
Post by: ronjonp on July 19, 2017, 01:27:08 PM
Just a quick guess but maybe you're passing nil to entget ... yup. Take a look at line 72 (setq objinsp (cdr (assoc 10 (entget objblk)))) ; block insertion point
Title: Re: When run line by line works good but the routine gives error
Post by: HasanCAD on July 19, 2017, 01:38:26 PM
Just a quick guess but maybe you're passing nil to entget ... yup. Take a look at line 72 (setq objinsp (cdr (assoc 10 (entget objblk)))) ; block insertion point

Solved There was missing line
This
Code - Auto/Visual Lisp: [Select]
  1.             (setq objstrng (cdr (assoc   1 lvlget)))
  2.             (setq objinsp  (cdr (assoc 10 (entget objblk)))) ; block insertion point
  3.             )

Should be
Code - Auto/Visual Lisp: [Select]
  1.             (setq objstrng (cdr (assoc   1 lvlget)))
  2.             (setq objblk   (cdr (assoc 330 lvlget)))
  3.             (setq objinsp  (cdr (assoc 10 (entget objblk)))) ; block insertion point
  4.             )

Thanks ronjonp
Title: Re: When run line by line works good but the routine gives error
Post by: ronjonp on July 19, 2017, 01:42:49 PM
Just a quick guess but maybe you're passing nil to entget ... yup. Take a look at line 72 (setq objinsp (cdr (assoc 10 (entget objblk)))) ; block insertion point

...

Thanks ronjonp
:)