One quick thing I see is you don't need to open the block editor to modify these blocks, just go directly to the block definition and make your changes. Here's a quick untested example with comments.
;;************************* { ADD PROPERTIES TO STANDARD CURV } ****************************;;
;; ;;
;; ------------------ Designed & Created by Satish Rajdev ------------------ ;;
;; ;;
;; ------------------ Command to Invoke = "9045-LH"----------------- ;;
;; ;;
;;********************************************************************************************;;
(defun c:9045-lh (/ vnum addprop bks cmd nm bkl a b c d e i)
;;********************************************************************************************;;
;;**************************************** UTILITIES ****************************************;;
;;********************************************************************************************;;
(defun *error* (msg)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(progn (princ "")
;; RJP - removed command calls
;;(setvar 'nomutt nm)
;;(setvar 'cmdecho cmd)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
(princ)
)
;; RJP - added function to return a list of block definition objects
(defun _mbd (name / e r)
(cond ((setq e (tblobjname "block" name))
(setq e (cdr (assoc 330 (entget e))))
(vlax-for x (vlax-ename->vla-object e) (setq r (cons x r)))
)
)
)
;; RJP - not needed, see below
;;; (defun removedup (l)
;;; (if l
;;; (cons (car l) (removedup (vl-remove (car l) (cdr l))))
;;; ;; removing duplicate element from the list
;;; )
;;; )
(defun addprop (obj layer)
(vla-put-color obj 256)
;; put color to bylayer
(vla-put-layer obj layer)
;; put in the layer specifed
)
(defun degrees->radians (numberofdegrees) (* pi (/ numberofdegrees 180.0)))
;;********************************************************************************************;;
;;************************************** MAIN PRAGRAM ***************************************;;
;;********************************************************************************************;;
(if (setq bks (ssget '((0 . "insert"))))
;; select block on screen
(progn (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(mapcar '(lambda (x y)
(or (tblsearch "layer" x) ; verifies layer are present or not
(entmakex (list '(0 . "layer")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 x)
;; add layername
(cons 70 0)
(cons 62 y)
;; add color
(cons 6 "Continuous")
)
)
)
;; creating layer
)
(list "HILMOT-CONV-BLK-ROLLERS"
"HILMOT-CONV-BLK-SENSORS"
"HILMOT-CONV-BLK-FRAMES"
"HILMOT-CONV-BLK-FULL_WIDTH_BELTS"
"HILMOT-CONV-BLK-DRIVE_CARDS"
"HILMOT-CONV-BLK-MDR'S"
"HILMOT-CONV-BLK-FLOW_ARROWS"
)
;; layer list
(list 8 1 4 3 5 6 7)
;; color code for the layers
)
(repeat (setq i (sslength bks))
;; RJP - Just check if the name is not in the list while compling then no need to remove duplicates
;; setting the repeat count
(or (vl-position (setq n (cdr (assoc 2 (entget (ssname bks (setq i (1- i))))))) bkl)
(setq bkl (cons n bkl))
)
;; getting the selected block list
)
;; (setq bkl (removedup bkl))
(foreach bk bkl
(foreach b (_mbd bk)
;; selecting all lines, splines and plines inside block in block editor
;(setq vnum (/ (length (vlax-get b 'coordinates)) 2))
;; getting each ellipse/all line objects
(cond ;; applying conditions here
((and (eq (vla-get-objectname b) "AcDbSpline")
(vlax-curve-isclosed b)
(< (vla-get-numberofcontrolpoints b) 20)
;;the object is a spline, closed & has less than 20 control points then do this
)
(addprop b "HILMOT-CONV-BLK-FRAMES")
)
((and (eq (vla-get-objectname b) "AcDbSpline")
(vlax-curve-isclosed b)
(> (vla-get-numberofcontrolpoints b) 20)
;;the object is a spline, closed & has more than 20 control points then do this
)
(vla-delete b)
)
((and (eq (vla-get-objectname b) "AcDbSpline")
(vlax-curve-isclosed b)
(> (vla-get-numberofcontrolpoints b) 13)
(< (vla-get-numberofcontrolpoints b) 15)
;;the object is a spline, NOT closed & has 14 control points then do this
)
(addprop b "HILMOT-CONV-BLK-FLOW_ARROWS")
)
((and (eq (vla-get-objectname b) "AcDbPolyline")
(vlax-curve-isclosed b)
(equal (/ (length (vlax-get b 'coordinates)) 2) 4)
)
;; if the object is POLYLINE with 4 vertices and it is closed then do this
(addprop b "HILMOT-CONV-BLK-SENSORS")
)
((and (eq (vla-get-objectname b) "AcDbPolyline")
(not (vlax-curve-isclosed b))
(equal (/ (length (vlax-get b 'coordinates)) 2) 8)
)
;; if the object is POLYLINE with 8 vertices and it is NOT closed then do this
(addprop b "HILMOT-CONV-BLK-SENSORS")
)
((and (eq (vla-get-objectname b) "AcDbPolyline")
(not (vlax-curve-isclosed b))
(equal (/ (length (vlax-get b 'coordinates)) 2) 4)
)
;; if the object is POLYLINE with 4 vertices and it is NOT closed then do this
(vla-delete b)
)
((and (eq (vla-get-objectname b) "AcDbPolyline")
(not (vlax-curve-isclosed b))
(equal (/ (length (vlax-get b 'coordinates)) 2) 7)
)
;; if the object is POLYLINE with 7 vertices and it is NOT closed then do this
(addprop b "HILMOT-CONV-BLK-DRIVE_CARDS")
)
((and (eq (vla-get-objectname b) "AcDbLine")
;; check object is LINE
(setq c (vlax-get b 'startpoint))
;; Get start point
(setq d (vlax-get b 'endpoint))
;; Get end point
(vl-some '(lambda (x) (equal (angle c d) x 0.00001))
'(1.11563763 4.20761659 0.33023947 3.42221842)
;; this angle list are measured manually from drawing from GREEN LINES
)
;; Check whether the angle between start & end point are matches with the list if matches then do this
)
(addprop b "HILMOT-CONV-BLK-MDR'S")
)
(t (addprop b "HILMOT-CONV-BLK-ROLLERS"))
)
)
)
;; RJP - No more command call so we don't have to set these
;;; (setvar 'nomutt nm)
;;; (setvar 'cmdecho cmd)
;;restoring the variables again
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
;;ending the undo mark
)
;; progn
)
;; if
(princ)
)
(vl-load-com)
(princ)
(princ (strcat "\n:: Add Prop to Standard Curve.lsp ::"
"\n:: Created by Satish Rajdev | "
(menucmd "M=$(edtime,$(getvar,date),DDDD\",\" D MONTH YYYY)")
" ::"
"\n:: Type \"9045-LH\" to Invoke ::"
)
)
(princ)
