Leaderboard

Try this quicky: The colour name must be words. You should alter the highlighted list for any colour names you want to add or delete (defun c:LM ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_*error*_defun (setq sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) ss (ssget "_X" '((0 . "TEXT") (410 . "Model"))) colour_lst (list "* RED *" "* YELLOW *" "* GREEN *" "* CYAN *" "* BLUE *" "* MAGENTA *");<<== Alter list of colours here );end_setq (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (vla-startundomark c_doc) (mapcar 'setvar sv_lst '(0 0)) (cond ( (not (tblobjname "LAYER" "COLOURS")) (vla-add (vla-get-layers c_doc) "COLOURS"))) (cond (ss (vlax-for obj (vla-get-activeselectionset c_doc) (setq t_str (vlax-get-property obj 'textstring) lyr (strcase (vlax-get-property obj 'layer)) ) (foreach col colour_lst (cond ( (wcmatch (strcase t_str) col) (if (not (vl-position lyr l_lst)) (setq l_lst (cons lyr l_lst))))) );end_foreach );end_for (cond (l_lst (foreach lyr l_lst (command "_.-laymrg" "_N" lyr "" "_N" "COLOURS" "_Y")))) ) );end_cond (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (princ) );end_defun ;;

If I understand you correctly you want to identify polylines that do not have a block inserted at their start and end point. This is possible. Sadly one of your blocks has been badly designed: The insertion point of the FOC block seems totally illogical. The code below works for the other blocks. (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret)) ) ) ) (defun c:Test ( / end polyLst ptLst ss ssOut sta) (if (setq ss (ssget "_X" '((0 . "INSERT,LWPOLYLINE")))) (progn (foreach obj (KGA_Conv_Pickset_To_ObjectList ss) (if (= "AcDbBlockReference" (vla-get-objectname obj)) (setq ptLst (cons (vlax-get obj 'insertionpoint) ptLst)) (setq polyLst (cons obj polyLst)) ) ) (setq ssOut (ssadd)) (foreach poly polyLst (setq sta (vlax-curve-getstartpoint poly)) (setq end (vlax-curve-getendpoint poly)) (if (not (and (vl-some '(lambda (pt) (equal pt sta 1e-8)) ptLst) (vl-some '(lambda (pt) (equal pt end 1e-8)) ptLst) ) ) (ssadd (vlax-vla-object->ename poly) ssOut) ) ) (sssetfirst nil ssOut) ) ) (princ) )

Here's a quick update to this code since vla-get-filedependencies was removed from AutoCAD 2018. (defun c:super (/ *error* dir vars) (vl-load-com) (defun *error* (msg) ;; Reset variables (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) (vl-mkdir (setq dir (strcat (getvar 'dwgprefix) "Superseded"))) (vl-mkdir (setq dir (strcat dir "\\" (menucmd "m=$(edtime,0,yyyy-mo-dd)")))) (if (findfile dir) (progn (setq vars (mapcar '(lambda (x) (cons x (getvar x))) '("cmdecho" "expert" "filedia"))) (mapcar '(lambda (a b) (setvar (car a) b)) vars '(0 5 0)) (command "_qsave") (command "-etransmit" "Current" "Create" (strcat dir "\\" (vl-filename-base (getvar 'dwgname))) ) (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) ) ) (princ) )

Try: (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret)) ) ) ) (defun KGA_List_Divide_3 (lst / ret) (repeat (/ (length lst) 3) (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret)) (setq lst (cdddr lst)) ) (reverse ret) ) (defun KGA_Sys_ObjectOwner (obj) (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj)) ) (defun LineToCurve (sta vec curve / end line ptLst) (setq line (vla-addline (KGA_Sys_ObjectOwner curve) (vlax-3d-point sta) (vlax-3d-point (mapcar '+ sta vec)) ) ) (if (setq ptLst (KGA_List_Divide_3 (vlax-invoke line 'intersectwith curve acextendthisentity))) (progn (setq end (car ptLst)) (foreach pt (cdr ptLst) (if (< (distance sta pt) (distance sta end)) (setq end pt) ) ) (vla-put-endpoint line (vlax-3d-point end)) line ) (progn (vla-delete line) nil ) ) ) (defun c:LinesToCurve ( / curve doc pt1 pt2 ss vec) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark doc) (vla-startundomark doc) (if (and (setq curve (car (entsel "\nSelect curve: "))) (setq curve (vlax-ename->vla-object curve)) (princ "\nSelect blocks: ") (setq ss (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "INSERT"))))) (setq pt1 (getpoint "\nFirst point for direction: ")) (setq pt2 (getpoint pt1 "\nSecond point for direction: ")) ) (progn (setq vec (trans (mapcar '- pt2 pt1) 1 0 T)) (foreach blk ss (LineToCurve (vlax-get blk 'insertionpoint) vec curve) ) ) ) (vla-endundomark doc) (princ) )