Leaderboard

(vl-load-com) (defun c:ARCTEST ( / ss ssl index tlist ent obj elist arclist arcrad arccenter arcalongcenter ll ur lll url midpt unitvect1 xline1 xlineobj unitvect2 ray1 tlen resultss 1text 1textcen cen2cen ray2 interpt) (setq ss (ssget '((0 . "ARC,TEXT")))) (setq ssl (sslength ss)) (setq index 0) (setq tlist '()) (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq elist (entget ent)) (cond ((eq (cdr (assoc 0 elist)) "ARC") (setq arclist (LM:ArcEndpoints ent)) (setq arcrad (cdr (assoc 40 elist))) (setq arccenter (cdr (assoc 10 elist))) (setq arcalongcenter (vlax-curve-getPointAtDist obj (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj ) ) 2 ) ) ) ) ((eq (cdr (assoc 0 elist)) "TEXT") (vla-getboundingbox obj 'll 'ur) (setq lll (vlax-safearray->list ll)) (setq url (vlax-safearray->list ur)) (setq midpt (mapcar '* (mapcar '+ lll url) '(0.5 0.5 0.5))) (setq tlist (cons (list ent midpt) tlist)) ) ) (setq index (+ index 1)) ) (setq unitvect1 (mapcar '(lambda (x) (/ x (distance (car arclist) (cadr arclist)))) (mapcar '- (cadr arclist) (car arclist)))) (setq xline1 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 (cadr arclist)) (cons 11 unitvect1) ) ) ) (setq xlineobj (vlax-ename->vla-object xline1)) (setq unitvect2 (mapcar '(lambda (x) (/ x (distance arcalongcenter arccenter))) (mapcar '- arccenter arcalongcenter))) (setq ray1 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 arcalongcenter) (cons 11 unitvect2) ) ) ) (setq tlen (length tlist)) (setq index 0) (setq resultss (ssadd)) (repeat tlen (setq 1text (nth index tlist)) (setq 1textcen (cadr 1text)) (setq cen2cen (distance 1textcen arccenter)) (if (<= cen2cen arcrad) (progn (ssadd (car 1text) resultss) ) (progn (setq ray2 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 1textcen) (cons 11 unitvect2) ) ) ) (setq interpt (LM:intersections xlineobj (vlax-ename->vla-object ray2) acextendnone)) (if (= interpt nil) (progn (ssadd (car 1text) resultss) ) (progn) ) (entdel ray2) ) ) (setq index (+ index 1)) ) (sssetfirst nil resultss) (entdel xline1) (entdel ray1) (princ) ) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;; Arc Endpoints - Lee Mac ;; Returns the endpoints of an Arc expressed in WCS (defun LM:ArcEndpoints (ent / cen nrm rad) (setq ent (entget ent) nrm (cdr (assoc 210 ent)) cen (cdr (assoc 010 ent)) rad (cdr (assoc 040 ent)) ) (mapcar (function (lambda (ang) (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) nrm 0 ) ) ) (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent))) ) ) how does it works, step by step gif. (vl-load-com) (defun c:ARCTEST ( / ss ssl index tlist ent obj elist arclist arcrad arccenter arcalongcenter ll ur lll url midpt unitvect1 xline1 xlineobj unitvect2 ray1 tlen resultss 1text 1textcen cen2cen ray2 interpt circleent) (setq ss (ssget '((0 . "ARC,TEXT")))) (setq ssl (sslength ss)) (setq index 0) (setq tlist '()) (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq elist (entget ent)) (cond ((eq (cdr (assoc 0 elist)) "ARC") (setq arclist (LM:ArcEndpoints ent)) (setq arcrad (cdr (assoc 40 elist))) (setq arccenter (cdr (assoc 10 elist))) (setq arcalongcenter (vlax-curve-getPointAtDist obj (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj ) ) 2 ) ) ) ) ((eq (cdr (assoc 0 elist)) "TEXT") (vla-getboundingbox obj 'll 'ur) (setq lll (vlax-safearray->list ll)) (setq url (vlax-safearray->list ur)) (setq midpt (mapcar '* (mapcar '+ lll url) '(0.5 0.5 0.5))) (setq tlist (cons (list ent midpt) tlist)) ) ) (setq index (+ index 1)) ) (setq unitvect1 (mapcar '(lambda (x) (/ x (distance (car arclist) (cadr arclist)))) (mapcar '- (cadr arclist) (car arclist)))) (setq xline1 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 (cadr arclist)) (cons 11 unitvect1) ) ) ) (setq xlineobj (vlax-ename->vla-object xline1)) (setq unitvect2 (mapcar '(lambda (x) (/ x (distance arcalongcenter arccenter))) (mapcar '- arccenter arcalongcenter))) (setq ray1 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 arcalongcenter) (cons 11 unitvect2) ) ) ) (setq circleent (entmakex (list (cons 0 "CIRCLE") (cons 10 arccenter) (cons 40 arcrad)))) (setq tlen (length tlist)) (setq index 0) (setq resultss (ssadd)) (repeat tlen (setq 1text (nth index tlist)) (setq 1textcen (cadr 1text)) (setq cen2cen (distance 1textcen arccenter)) (if (<= cen2cen arcrad) (progn (ssadd (car 1text) resultss) (vlax-put-property (vlax-ename->vla-object (car 1text)) 'textstring "Gotcha (Circle)") (vlax-put-property (vlax-ename->vla-object (car 1text)) 'color 2) ) (progn (setq ray2 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 1textcen) (cons 11 unitvect2) ) ) ) (setq interpt (LM:intersections xlineobj (vlax-ename->vla-object ray2) acextendnone)) (if (= interpt nil) (progn (ssadd (car 1text) resultss) (vlax-put-property (vlax-ename->vla-object (car 1text)) 'textstring "Gotcha (Ray)") (vlax-put-property (vlax-ename->vla-object (car 1text)) 'color 3) ) (progn) ) (setq answer (getstring)) (entdel ray2) ) ) (setq index (+ index 1)) ) (sssetfirst nil resultss) (entdel xline1) (entdel circleent) (entdel ray1) (princ) ) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;; Arc Endpoints - Lee Mac ;; Returns the endpoints of an Arc expressed in WCS (defun LM:ArcEndpoints (ent / cen nrm rad) (setq ent (entget ent) nrm (cdr (assoc 210 ent)) cen (cdr (assoc 010 ent)) rad (cdr (assoc 040 ent)) ) (mapcar (function (lambda (ang) (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) nrm 0 ) ) ) (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent))) ) )

I'm moderately getting more proficient in using LISP for 2D applications and learning more about leveraging it in 3D applications, all in AutoCAD. I haven't dabbled in DCL file extensions but that's just for display. I attached something I did a few months ago for annotating blocks. Shoot me a message, it seems interesting what you have on there. SUSP_CALL Demo.mp4

OK so the only error I can see is the xedges command needs to end: (command "xedges" "all" "")

What are your skills with lisp, that will determine what help we need to give you - might be you just need to know the relevant commands, might be that you know nothing of LISPs and want the finished thing... or anything in between. Will your LISP just be extending or trimming to a closed object (like the square above) or will it be to any object?