Hi JS, I just finished sample code to hatching rooms if these have asbestos
Try it as is on your drawing you've sent me before, other parts of code
I will be finish tomorrow,
btw there is no asbestos block in there, where I can find it on my AutoCAD,
perhaps in Architectural palette?
tell me please
Code:
;;-------------------------------------------------- code start ----------------------------------------;;
(defun C:RML (/ *error* asbindexed asbmatches asbtype blkobj dxf ents getattvalue file floorindexed floornum fname found i info
listbounds objs p1 p2 pline plineobj pos plinepoints ptlist read-csv records rmset roominfo rooms room_ref sp sset tmpset x)
(defun *error* (msg)
(if
(vl-position
msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
(princ "Error!")
(princ msg)
)
(if (= (logand (getvar "UNDOCTL") 4) 4)
(command "_UNDO" "_END")
)
(princ)
)
;; local functions:
;; return element from association list entry
(defun dxf (key alist) (cdr (assoc key alist)))
;; get lwpolyline vertices
(defun plinepoints (en)
(vl-remove-if
'not
(mapcar '(lambda (x)
(if (= 10 (car x))
(cdr x)
)
)
(entget en)
)
)
)
;; read csv file to a list
(defun read-csv (fname del / strtolst ptlist)
;; by gile
(defun strtolst (str del)
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos)
(strtolst (substr str (+ pos 1 (strlen del))) del)) (list str)
)
)
(if (setq file (open fname "r"))
(progn
(setq records nil)
(while (setq sp (read-line file))
(setq records (cons (strtolst sp del)records))
)
(close file)
)
)
(if records (reverse records) nil)
)
;; retrieve single attribute value by tag
(defun getattvalue (blkobj atag / at atts attvalue)
(setq atts (vlax-safearray->list
(variant-value
(vla-getattributes blkobj)
)
)
)
(foreach at atts
(if (eq atag (vla-get-tagstring at))
(setq attvalue (vla-get-textstring at)))
)
attvalue
)
;; main part:
;(setq fname (getfiled "Select CSV:" "" "CSV" 4))
(setq records (read-csv fname (chr 59)));<--- \tab = (chr 9) ; = (chr 59) , = (chr 44)
(setq floornum (getstring (strcat "\nSpecify floor number <0>: ")))
(if (eq "" floornum)(setq floornum "0"))
;; remove headers
(setq records (vl-remove (car records) records))
(setq floorindexed (mapcar '(lambda (x)(list (nth 2 x)(nth 4 x)(nth 12 x)))records))
;; extract records that matches to floor number
(setq asbindexed (mapcar 'cdr (vl-remove-if-not '(lambda(x)(eq floornum (car x))) floorindexed)))
(setq asbmatches (mapcar '(lambda(x)(apply 'cons x)) asbindexed))
(setvar "cmdecho" 0)
(setvar "hpname" "SOLID")
(if (= (logand (getvar "UNDOCTL") 4) 4)
(command "_UNDO" "_GROUP")
)
(setq p1 (getpoint "\nSpecify first corner point of floor plan: ")
p2 (getcorner p1"\nSpecify opposite corner: "))
(command "_.SELECT" "_W" p1 p2 "")
(command "_zoom" "_w" p1 p2)
(setq sset (ssget "_P" '((0 . "insert")(2 . "ROOM")(8 . "ROOMTEXT")(66 . 1))))
(setq info (ssnamex sset)
ents (vl-remove-if 'listp (mapcar 'cadr info))
objs (mapcar 'vlax-ename->vla-object ents))
;; select specific room bounds on layer "NC_Attributes"
(setq rmset (ssget "_X" (list (cons 0 "lwpolyline")(cons 8 "NC_Attributes"))))
(setq roominfo (ssnamex rmset)
rooms (vl-remove-if 'listp (mapcar 'cadr roominfo)))
;; get all rooms boundary and associated points of them all
(setq listBounds (mapcar '(lambda (x)(cons x (plinepoints x))) rooms))
;; set counter
(setq i 0)
(while (setq ptlist (cdr (nth i listBounds)))
(if (setq tmpset (ssget "_wp" ptlist '((0 . "insert")(2 . "ROOM")(8 . "ROOMTEXT")(66 . 1))))
(progn
(setq found (ssname tmpset 0))
(setq blkobj(vlax-ename->vla-object found))
(setq room_ref (getattvalue blkobj "ROOM_REF"))
(setq asbtype (cdr (assoc room_ref asbmatches)))
(setq pline (car (nth i listBounds))
plineobj(vlax-ename->vla-object pline))
(command "-bhatch" "_S" pline "" "")
(command "_chprop" "_L" "" "_Color" asbtype "")))
(setq i (1+ i))
)
(*error* nil)
(princ)
)
(prompt "\n\t\t --- Start command with RML ---\n")
(prin1)
(vl-load-com)
(princ)
;;-------------------------------------------------- code end -------------------------------------------;;