Code:
(vl-load-com)
(defun c:AAS (/ *error* rtd acDoc ok ss layerName oLayer)
(defun *error* (msg)
(if ss (vla-delete ss))
(if acDoc
(vla-endundomark acDoc)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(defun rtd (ang) (/ (* ang 180.0) pi))
(if (= 2 (getvar 'cvport)) ; in model or active pviewport
(progn
(if (ssget "_X" '((0 . "LWPOLYLINE") (410 . "Model")))
(progn
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq ok T)
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(vla-explode x)
(vla-delete x)
)
(vla-delete ss)
(setq ss nil)
)
)
(if (ssget "_X" '((0 . "LINE") (410 . "Model")))
(progn
(if (not ok)
(vla-startundomark
(setq acDoc
(vla-get-activedocument (vlax-get-acad-object))
)
)
)
(setq oLayer (vla-add (vla-get-layers acDoc)
(setq layerName "0_NotStraight")
)
)
(vla-put-color oLayer acyellow)
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(if
(not (vl-position
(atof (rtos (rtd (vla-get-angle x)) 2 2))
'(0.0 15.0 30.0 45.0 60.0 90.0)
;; ^^ more angles here? ^^
)
)
(vl-catch-all-apply 'vla-put-layer (list x layerName)) ; assumes unlocked layers
)
)
)
)
)
(prompt "\n** Command not allowed in paper space ** \n")
)
(*error* nil)
)