How to let user select entities or KWord in AutoLISP? - autocad-plugin

In my command I want to let user select entities, but if he wants, he should be able to use KWord.
Something like command with prompt:
Select elements od [Settings]:
I know that I can use KWord while entsel.
But entsel allows me to select only one entity,
ssget let me select many entities - which is neede, but can't use KWords.
Or I mismatched something ?
Do You know any way to join both: select many entities and KWord?

Since the AutoLISP ssget function offers its own keywords to allow the user to initiate any of the standard selection methods (Window, Crossing, Fence, etc.), it is not one of the functions supported by the initget (keyword initialising) function:
Expects a point or Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle
There are two alternative techniques that come to mind which could potentially allow the user to supply arbitrary predefined keywords whilst also permitting multiple selection:
Use an entsel or nentsel selection within a while loop, permitting multiple single-pick selections (i.e. selection using the pickbox aperture, with no window selection).
Develop your own ssget function through the use of the grread function within a loop to continuously capture user input.
I attempted the latter back in 2010, when I developed a 'UCS-aligned ssget function' (i.e. such that the selection window is aligned with the active UCS) - with full control over how user input is handled, you can then define your own keywords and react accordingly when the input matches such keywords:
;;------------------=={ UCS Aligned ssget }==-----------------;;
;; ;;
;; Provides the user with a selection interface akin to ;;
;; those options provided by ssget, but aligned to the ;;
;; active UCS ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - prompt to be displayed ;;
;; filter - optional SelectionSet filter ;;
;;------------------------------------------------------------;;
;; Returns: SelectionSet, else nil ;;
;;------------------------------------------------------------;;
(defun LM:UCS-ssget
(
msg filter /
*error* _redrawss _getitem _getwindowselection
acgrp e express g1 g2 gr grp i mss multiplemode pick pt removemode singlemode ss str
)
(defun *error* ( msg )
(_redrawss ss 4)
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun _redrawss ( ss mode / i )
(if ss
(repeat (setq i (sslength ss))
(redraw (ssname ss (setq i (1- i))) mode)
)
)
)
(defun _getitem ( collection item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
item
)
)
(defun _getwindowselection ( msg p1 filter flag / gr p2 p3 p4 lst )
(princ msg)
(while (not (= 3 (car (setq gr (grread t 13 0)))))
(cond
( (= 5 (car gr))
(redraw)
(setq p3 (cadr gr)
p2 (list (car p3) (cadr p1) (caddr p3))
p4 (list (car p1) (cadr p3) (caddr p3))
)
(grvecs
(setq lst
(list
(cond
( (eq "_C" flag) -256)
( (eq "_W" flag) 256)
( (minusp (- (car p3) (car p1))) -256)
( 256 )
)
p1 p2 p1 p4 p2 p3 p3 p4
)
)
)
t
)
( (princ (strcat "\nInvalid Window Specification." msg)) )
)
)
(redraw)
(ssget (cond ( flag ) ( (if (minusp (car lst)) "_C" "_W") )) p1 p3 filter)
)
(setq express
(and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down)))
)
)
)
)
)
(setq acdoc (cond ( acdoc ) ( (vla-get-activedocument (vlax-get-acad-object)) ))
acgrp (vla-get-groups acdoc)
)
(if
(not
(and
(= 1 (getvar 'PICKFIRST))
(setq ss (cadr (ssgetfirst)))
)
)
(setq ss (ssadd))
)
(setq str "")
(sssetfirst nil nil)
(princ msg)
(while
(progn
(setq gr (grread t 13 2)
g1 (car gr)
g2 (cadr gr)
)
(_redrawss ss 3)
(cond
( (= 5 g1) )
( (= 3 g1)
(cond
( RemoveMode
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(if (ssmemb pick ss)
(progn (ssdel pick ss) (redraw pick 4))
)
(if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
(repeat (setq i (sslength pick))
(if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
(progn (ssdel e ss) (redraw e 4))
)
)
)
)
(princ msg)
)
( MultipleMode
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(ssadd pick mss)
)
t
)
( t
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(if (and express (acet-sys-shift-down))
(if (ssmemb pick ss)
(progn (ssdel pick ss) (redraw pick 4))
)
(ssadd pick ss)
)
(if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
(if (and express (acet-sys-shift-down))
(repeat (setq i (sslength pick))
(if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
(progn (ssdel e ss) (redraw e 4))
)
)
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
)
)
)
(princ msg)
(not SingleMode)
)
)
)
( (= 2 g1)
(cond
( (member g2 '(32 13))
(cond
( (zerop (strlen str))
nil
)
( t
(if mss
(progn
(repeat (setq i (sslength mss))
(ssadd (ssname mss (setq i (1- i))) ss)
)
(setq mss nil)
)
)
(cond
( (wcmatch (setq str (strcase str)) "R,REMOVE")
(setq
MultipleMode nil
SingleMode nil
RemoveMode T
)
)
( (wcmatch str "M,MULTIPLE")
(setq
RemoveMode nil
SingleMode nil
MultipleMode T
mss (ssadd)
)
)
( (wcmatch str "A,ADD,AUTO")
(setq
MultipleMode nil
RemoveMode nil
SingleMode nil
)
t
)
( (wcmatch str "SI,SINGLE")
(setq
MultipleMode nil
RemoveMode nil
SingleMode T
)
)
( (wcmatch str "G,GROUP")
(while
(progn (setq grp (getstring t "\nEnter group name: "))
(cond
( (eq "" grp)
nil
)
( (setq grp (_getitem acgrp grp))
(vlax-for obj grp
(if (not (ssmemb (setq e (vlax-vla-object->ename obj)) ss))
(ssadd e ss)
)
)
nil
)
( (princ "\nInvalid group name.") )
)
)
)
t
)
( (or
(eq str "ALL")
(wcmatch str "P,PREVIOUS")
(wcmatch str "L,LAST")
)
(princ
(strcat "\n"
(if
(setq pick
(ssget
(cond
( (eq str "ALL") "_X")
( (wcmatch str "P,PREVIOUS") "_P")
( (wcmatch str "L,LAST") "_L")
)
filter
)
)
(progn
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
(itoa (sslength pick))
)
"0"
)
" found"
)
)
t
)
( (or
(eq str "BOX")
(wcmatch str "W,WINDOW")
(wcmatch str "C,CROSSING")
)
(princ
(strcat "\n"
(if
(and
(setq pt (getpoint "\nSpecify first corner: "))
(setq pick
(_getwindowselection "\nSpecify opposite corner: " pt filter
(cond
( (eq str "BOX") nil)
( (wcmatch str "W,WINDOW") "_W")
( (wcmatch str "C,CROSSING") "_C")
)
)
)
)
(progn
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
(itoa (sslength pick))
)
"0"
)
" found"
)
)
t
)
( (wcmatch str "U,UNDO")
(if pick
(cond
( (eq 'ENAME (type pick))
(ssdel pick ss)
(redraw pick 4)
)
( (eq 'PICKSET (type pick))
(repeat (setq i (sslength pick))
(setq e (ssname pick (setq i (1- i))))
(ssdel e ss)
(redraw e 4)
)
)
)
)
t
)
( (eq "?" str)
(princ
(strcat
"\nExpects a point or"
"\nWindow/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon"
"/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle"
)
)
)
( (princ "\n** Invalid Keyword **") )
)
(setq str "")
(princ msg)
)
)
)
( (< 32 g2 127)
(setq str (strcat str (princ (chr g2))))
)
( (= g2 8)
(if (< 0 (strlen str))
(progn
(princ (vl-list->string '(8 32 8)))
(setq str (substr str 1 (1- (strlen str))))
)
)
t
)
( t )
)
)
)
)
)
(_redrawss ss 4)
ss
)
;; Test function
(defun c:test nil
(sssetfirst nil (LM:UCS-ssget "\nSelect Objects: " nil))
(princ)
)

Related

How can I amend the below code to add additional materials to the LISP

I am new to coding but very eager to learn. I am attempting to edit this existing LISP to add additional materials to the list. Currently when I run the LISP it only has Aluminium as an option to select. I would like to add additional materials and weights to suit. I also would like to know how to change the weight settings from LBS/FT to Kilograms & Meters.
Any help would be hugely appreciated.
;;; Lisp function for calculating weight with choice to assign material for selected:
;;; 2d shape - expressed in pounds per foot lenght - lbs/ft.
;;; or
;;; 3d solid - expressed in Pounds - lbs
(defun C:Wt (/ area volume en ent obj ospace prefix pt remd resp suffix suffix1)
;;local defun
(defun density (mat)
(cond ((eq "Aluminium" mat) 0.0972) ;<--lb/in³
;; add other materials density similarly
(T nil)
)
)
(defun matname (mat)
(cond ((eq "Aluminium" mat) " mat: Aluminium")
;; add other materials names similarly
(T nil)
)
)
;;main part
(setvar "dynmode" 3)
(setvar "dynprompt" 1)
(setq ospace (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
)
(setq prefix "Weight="
suffix "lbs/ft."
suffix1 "lbs"
)
(setq ent (entsel "\nSelect a object:"))
(setq en (car ent))
(if (wcmatch (cdr (assoc 0 (entget en)))
"REGION,*POLYLINE,CIRCLE,ELLIPSE"
)
(progn
(setq obj (vlax-ename->vla-object en))
(initget
"Aluminium"
) ;<-- add other materials here
(setq resp
(getkword
"\Choose material [ALuminium] <AL>: "
)
)
(setq area (strcat prefix
(rtos (* (vla-get-area obj)
(density resp)
)
3 ;<-- inches
4 ;<-- precision
)
suffix
(matname resp)
)
)
(setq pt (getpoint "\nPick text point: "))
(vla-addtext
ospace
area
(vlax-3d-point (trans pt 1 0))
(getvar 'Textsize)
)
)
)
(princ)
(if (wcmatch (cdr (assoc 0 (entget en))) "3DSOLID")
(progn
(setq obj (vlax-ename->vla-object en))
(initget
"Aluminium Steel SS316 Glass Rubber Silicone Plastic Granit Marble"
) ;<-- add other materials here
(setq resp
(getkword
"\Choose material
[ALuminium/STeel/SS316/GLass/RUbber/SIlicone/PLastic/GRanit/MArble] <AL>: "
)
)
(setq volume (strcat prefix
(rtos (* (vla-get-volume obj)
(* (density resp) 0.001)
)
2 ;<-- metric
5 ;<-- precision
)
suffix1
(matname resp)
)
)
(setq pt (getpoint "\nPick text point: "))
(vla-addtext
ospace
volume
(vlax-3d-point (trans pt 1 0))
(getvar 'Textsize)
)
)
)
(princ)
)

how to change attribute of block using ObjectDBX

I need to change an attribute of drawing with the ObjectDBX method using AutoLISP. this routine run properly but not change the attribute,can you suggest any change in code or any other method to achieve this task?
Thank you.
;;;;;;;;;;;;;;;;;;;
(defun DBX_ATT_CHANGE (f)
(vl-load-com)
(setq cadver (substr (getvar "acadver") 1 2))
(setq id (strcat "objectdbx.AxDbDocument." cadver))
(setq dbx (vlax-create-object id))
(vla-open dbx f)
(vlax-for n_object (vla-get-modelspace dbx)
(setq dbx_en (vlax-vla-object->ename n_object))
(setq upc_blkobj (vlax-ename->vla-object dbx_en))
(if (vlax-method-applicable-p upc_blkobj 'GetAttributes)
(progn
(setq upc_attlist
(vlax-invoke upc_blkobj 'GetAttributes)
)
(foreach upc_att upc_attlist
(progn
(if (= (vla-get-tagstring upc_att) (strcase "P_TAG1"))
(vlax-put-property
upc_att
'TextString
"555"
)
)
)
)
)
)
(vlax-release-object upc_blkobj)
)
(vla-saveas dbx dwgfile)
(vlax-release-object dbx)
(prin1)
)
(defun c:test ()
(DBX_ATT_CHANGE
"D:/6. R&D/Delet Group LispDBXapi/7-EU-FE-48-AC-CIOC-SA - Copy.dwg"
)
)
;;;;;;;;;;;;;;;
There are a couple of oddities present in your current code:
(setq dbx_en (vlax-vla-object->ename n_object))
(setq upc_blkobj (vlax-ename->vla-object dbx_en))
You are converting the vla-object n_object into an entity name dbx_en, and then converting this entity name back into a vla-object upc_blkobj. These two lines are redundant, as you can work with the n_object variable directly.
(= (vla-get-tagstring upc_att) (strcase "P_TAG1"))
You are using strcase to convert a literal uppercase string P_TAG1 to uppercase, and then comparing this uppercase string to a string which may or may not be uppercase - I believe this line should be:
(= (strcase (vla-get-tagstring upc_att)) "P_TAG1")
To offer you an alternative for this task, you could make use of my ObjectDBX Wrapper function, which provides a way to evaluate a given function on another drawing or set of drawings, without opening such drawings in the AutoCAD Editor.
I would personally write your code in the following way:
(defun c:test ( )
(LM:DBXAttChange
"D:\\6. R&D\\Delet Group LispDBXapi\\7-EU-FE-48-AC-CIOC-SA - Copy.dwg"
'(("P_TAG1" . "555"))
)
(princ)
)
(defun LM:DBXAttChange ( dwg lst / doc flg val )
(if (setq doc (LM:GetDocumentObject dwg))
(progn
(vlax-for lyt (vla-get-layouts doc)
(vlax-for obj (vla-get-block lyt)
(if (and (= "AcDbBlockReference" (vla-get-objectname obj))
(= :vlax-true (vla-get-hasattributes obj))
)
(foreach att (vlax-invoke obj 'getattributes)
(if (and (setq val (cdr (assoc (strcase (vla-get-tagstring att)) lst)))
(vlax-write-enabled-p att)
)
(progn
(vla-put-textstring att val)
(setq flg t)
)
)
)
)
)
)
(if flg (vla-saveas doc dwg))
(vlax-release-object doc)
flg
)
(prompt (strcat "\nThe drawing \"" dwg "\" was not found or could not be accessed."))
)
)
;; Get Document Object - Lee Mac
;; Retrieves the VLA Document Object for the supplied filename.
;; The Document Object may be present in the Documents collection, or obtained through ObjectDBX.
;; It is the callers responsibility to release such object.
(defun LM:GetDocumentObject ( dwg / app dbx dwl err vrs )
(cond
( (not (setq dwg (findfile dwg))) nil)
( (cdr
(assoc (strcase dwg)
(vlax-for doc (vla-get-documents (setq app (vlax-get-acad-object)))
(setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
)
)
)
)
( (progn
(setq dbx
(vl-catch-all-apply 'vla-getinterfaceobject
(list app
(if (< (setq vrs (atoi (getvar 'acadver))) 16)
"objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
)
)
)
)
(or (null dbx) (vl-catch-all-error-p dbx))
)
(prompt "\nUnable to interface with ObjectDBX.")
)
( (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-open (list dbx dwg))))
(prompt (strcat "\n" (vl-catch-all-error-message err)))
)
( dbx )
)
)
(vl-load-com) (princ)

Add element to all open files

I've been using AutoLISP/CAD for a while and now I want to add a label with my name to all the open files. I've managed to iterate over all the open files, but the text command only runs in the first file. I thought it was too quick for CAD to work properly, so I added delays but it didn't work. I've checked in all the open files and the variables are shared and synced. By the way, the text is added once per open file, but only in the first one.
Here is my code:
(defun c:labeling()
(vl-load-com)
(setq docs (vla-get-documents (vlax-get-acad-object)))
(setq top (vla-get-count docs))
(setq p1 (list 10 -10))
(setq p2 (list 95 -15))
(setq p3 (list 12 -14))
(setq c 0)
(vl-propagate 'docs)
(vl-propagate 'top)
(vl-propagate 'p1)
(vl-propagate 'p2)
(vl-propagate 'p3)
(vl-propagate 'c)
(while (< c top)
(vla-activate (vla-item docs c))
(command "_rectang" p1 p2)
(command "delay" 500)
(command "_text" p3 "3" 0 "My name - year" "" nil)
;(print c)
(setq c (+ c 1))
(vl-propagate 'c)
(command "delay" 1000)
)
)
It's a bit complicated to explain in such short time I have but:
Each drawig has his own "namespace" probably it's wrong word, but nevermind.
When You run command it runs only in active drawing, but when You change active drawing You lost active lisp routine.
So it's not enought to activate drawing.
Better way is to draw by manipulate model object. for example like this:
(defun c:labeling()
(vl-load-com)
(setq docs (vla-get-documents (vlax-get-acad-object)))
(setq top (vla-get-count docs))
(setq p1 (list 10 -10))
(setq p2 (list 95 -15))
(setq p3 (list 12 -14))
(setq c 0)
(vlax-for ThisDoc docs
(setq Space (vlax-get-property ThisDoc 'ModelSpace ) )
(Rectangle Space p1 p2 )
(setq txt (vlax-invoke-method Space 'AddText "My name - year" (vlax-3d-point p3 ) 3 ))
(setq c (+ c 1))
)
)
(defun Rectangle ( Space P1 P2 / lpts pts poly )
(setq lpts (append p1 (list 0 ) (list (car p1 ) (cadr p2 ) 0 ) p2 (list 0 ) (list (car P2) (cadr p1) 0 ) ) )
(setq pts (L2v lpts vlax-vbDouble ) )
(setq poly(vlax-invoke-method Space 'AddPolyline pts ) )
(vlax-put-property poly 'Closed :vlax-true )
poly
)
(defun L2v(lista typ / NObj SelObjArray iCount iList SelObjArrayVar)
;|
vlax-vbInteger (2) Integer
vlax-vbLong (3) Long integer
vlax-vbSingle (4) Single-precision floating-point number
vlax-vbDouble (5) Double-precision floating-point number
vlax-vbString (8) String
vlax-vbBoolean (11) Boolean
vlax-vbVariant (12) Variant
|;
(setq NObj (length lista)
SelObjArray (vlax-make-safearray typ (cons 0 (1- NObj) ))
iCount 0)
(repeat NObj
(vlax-safearray-put-element SelObjArray iCount (nth iCount lista))
(setq iCount (1+ iCount))
)
(setq SelObjArrayVar (vlax-make-variant SelObjArray))
)

Change 3d polyline to spline in Autocad with lisp

I have a working lisp which creates spline from 3d polylines. My problem is I cant make it work to select multiple 3d polylines or entire layer, and also a lisp changes the result layer to the default layer. It should kept on the original one.
Here is my working lisp:
(defun c:3p2spl ( / *error* line2spl loop pl e s ss sss )
(vl-load-com)
(defun *error* ( msg )
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
(defun line2spl ( e / sp ep d )
(setq sp (cdr (assoc 10 (entget e)))
ep (cdr (assoc 11 (entget e)))
d (distance sp ep)
)
(entdel e)
(entmakex
(list
'(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
'(42 . 1.0e-010) '(43 . 1.0e-010) '(40 . 0.0) '(40 . 0.0) (cons 40 d) (cons 40 d) (cons 10 sp) (cons 10 ep)
)
)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq loop T)
(setq sss (ssget "_I"))
(if (and sss (eq (cdr (assoc 0 (entget (setq pl (ssname sss 0))))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 14)) (setq loop nil))
(while loop
(setq pl (car (entsel "\nPick 3DPOLYLINE to convert it to SPLINE")))
(if (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 14)) (setq loop nil))
)
(setq e (entlast))
(command "_.explode" pl "")
(setq ss (ssadd))
(while (setq e (entnext e))
(if (eq (cdr (assoc 0 (entget e))) "LINE")
(progn
(setq s (line2spl e))
(ssadd s ss)
)
)
)
(command "_.join" (ssname ss 0) ss "")
(*error* nil)
(princ)
)
if I change the ssget "_I" to ssget "_:E" I can select multiple lines however it will change to spline only the first one.
I didn't test this code, only read, so maybe I'm wrong, but I thing the problem is because:
...
(setq pl (ssname sss 0))
...
(command "_.explode" pl "")
You explode only first entity.
I think
(command "_.explode" pl "")
should be used inside loop by all sss items.

autocad : script that runs autolisp functions

I've got a working batch-file that runs a script on a bunch of drawings.
The script is supposed to run a lisp-function but that function appears to only run after the main function has ran.
since I don't know much about lisps, I'll try to give the information I have.
the lsp :
(princ "\nLoading AREAS...")
(defun c:areas(); Start the program.
(setvar "cmdecho" 0)
(if (= (getvar "tilemode") 1)
(progn
(command "_.ucs" "_world")
(setq osnp (getvar "osmode"))
(setq laag (getvar "clayer"))
(setvar "osmode" 0)
(setq dimz (getvar "dimzin"))
(setvar "dimzin" 0)
(ge_dellay ladeptmp)
(if (>= (substr (getvar "acadver") 1 2) "15")
(ge_convert)
)
(setq allsel (list (cons 0 "POLYLINE")'(-4 . "<OR")(cons 8 ladeppoly)(cons 8 ladeptraf)'(-4 . "OR>")'(-3 ("COSBI"))))
(setq depsel (list (cons 0 "POLYLINE")(cons 8 ladeppoly)'(-3 ("COSBI"))))
(setq areasel (list (cons 0 "POLYLINE")(cons 8 ladeptraf)'(-3 ("COSBI"))))
(setq textsel (list (cons 0 "TEXT")(cons 8 ladeptext)'(-3 ("COSBI"))))
(setq dcl_area (load_dialog "areas"))
(setq dcl_gen (load_dialog "general"))
(setq intp nil dparea nil seltot nil)
(ar_setdep)
(ar_dia)
(if (= what_next 1)(ar_setlay))
(if (= what_next 2)(ar_check))
(if (= what_next 3)(ar_startcheck))
(unload_dialog dcl_area)
(unload_dialog dcl_gen)
(setvar "osmode" osnp)
(setvar "clayer" laag)
(setvar "dimzin" dimz)
(ge_dellay ladeptmp)
)
(alert "Only allowed in original drawing...")
)
(princ)
)
is followed by a few other (not sure) less important functions, like the ar_dia - which opens a dialog box with buttons to call other functions.
One of the other functions is AR_LIST, which is the one I need to run on each file the batch-file opens, in a script.
the ar_list is a few blocks down and looks like this
(defun ar_list(); Make department/areas list.
(setq sel (ssget "x" allsel))
(if sel
(progn
(setq temp (findfile "template.sqm"))
(if temp
(progn
(command "_.zoom" "_all")
(setq rowlist nil deplist nil)
(setq bestand (open temp "r"))
(setq row (read-line bestand))
(while row
(setq row (read-line bestand))
(if row
(progn
(setq rowlist (cons (strcase (strcat (spatie (substr row 23 14)) "_-")) rowlist))
(setq deplist (cons (strcase (spatie (substr row 23 14))) deplist))
)
)
)
(setq country (ge_dir 3 "Country"))
(ge_dwg)
(if (= (strlen dwgnaam) 9); 3to4storenr
(progn
(setq store (substr dwgnaam (- (strlen dwgnaam) 3))); 3to4storenr
(setq floor (substr dwgnaam (- (strlen dwgnaam) 5) 2)); 3to4storenr
(setq num 0)
(repeat (sslength sel)
(setq depname (cdr (cadadr (assoc -3 (entget (ssname sel num)'("COSBI"))))))
(if (not (wcmatch depname "*`island*"))
(progn
(setq ename (ssname sel num))
(command "_.area" "_a" "_o" ename "")
(ge_puntlist ename)
(setq numpol 0)
(setq selpol (ssget "_wp" puntlist allsel))
(if selpol
(repeat (sslength selpol)
(setq islname (cdr (cadadr (assoc -3 (entget (ssname selpol numpol)'("COSBI"))))))
(if (= islname (strcat depname "-island"))
(command "_s" "_o" (ssname selpol numpol) "")
)
(setq numpol (1+ numpol))
)
)
(command "")
(setq deparea (/ (getvar "area") 1000000))
(if (not (member (strcase depname) deplist))
(progn
(setq deplist (cons (strcase depname) deplist))
(setq rowlist (cons (strcase (strcat depname "_-")) rowlist))
)
)
(setq nummem (- (length deplist)(length (member (strcase depname) deplist))))
(setq deptot (nth nummem rowlist))
(vindpos "_" deptot)
(setq depareaold (substr deptot (+ pos 1)))
(if (/= depareaold "-")
(setq deparea (+ (atof depareaold) deparea))
)
(setq rowlist (subst (strcase (strcat depname "_" (rtos deparea 2 1))) (nth nummem rowlist) rowlist))
)
)
(setq num (1+ num))
)
(command "_.zoom" "_previous")
(setq rowlist (acad_strlsort rowlist)); 13-10-2014
(setq deplist (acad_strlsort deplist)); 13-10-2014
;(setq rowlist (reverse rowlist))
;(setq deplist (reverse deplist))
(ar_write)
)
(alert (strcat "Drawing name " dwgnaam " not correct, must be 9 characters.")); 3to4storenr
)
)
(alert "File TEMPLATE.SQM not found...")
)
)
(alert "No department or traffic found...")
)
)
the script only needs to run this command, close the drawing, and don't save.
so I tried (test.scr)
(ar_list)
quit
n
but that gives me the error:
Command: (ar_list)
bad argument type: stringp nil
I think the ar_list needs something from the defun c:areas , but I don't know what. The ar_list works after entering areas in the command bar.
So I also tried
areas
(ar_list)
quit
n
, but that opened the areas dialog box, does not close it, blocking the loop.
Also, when I cancel the dialog box, the ar_list works, but it again opens the areas dialog box. I think the code repeats itself in the script.
Any help would be very welcome. I received related help on here
stringp nil give us sugestion that some variable which should be text string in fact is nil. Probably because it reads value from dialog control (which is unavaliable while dialog is not active).
there is few places which may cause such problem:
we don't know what happes in ge_dir ge_dwg ge_puntlist vindpos ar_write
ar_write Maybe want to write something to dialog?
variable dwgnaam is used as string but never initialized in this function, (maybe somewhere else it is?)
(setq depname (cdr (cadadr (assoc -3 (entget (ssname sel num)'("COSBI")))))) (if (not (wcmatch depname "*island*")) if selected entity not contains XData "cosbi", it can be problem, but if I'm not wrong, there is other error message.

Resources