Leaderboard

I wanted more buttons but ran out of space so just created an alternative reallity for myself. It's very basic / simple and still a work in progress but as usual time is not on my side especially now my boss in away for 4 weeks and he probably was afraid I would get bored and start to play with myself so he left me with a load of work. Update : because this routine uses grread you can't run any other (transparent) commands. Thats why I added 'hot' keys for zoom. E for extents, Z for zoom , + & - for zooming in & out. Maybe it's useful , maybe it's not...bite me. ;;; RlxGrMenu - 2025-07-09 - Just a funny / very basic little 'toolbar' ;;; It draws a column with 12 rows. Config is not working yet, quit by click or by typing Q or q. ;;; I've run a little out of button-space so wanted an out of the box solution to this problem. ;;; this is just a way to run my 10 most used lisp routines, nothing more , nothing less. ;;; Substitute the names in app-list (setq app-list '("LC" "VT" ...) with names from your own favorite apps ;;; apps have to be in search path so (findfile (strcat "MyApp" ".lsp") should work'. ;;; Also app should not be self executing and the start command should be same as app name ;;; If your app is named "MyApp" this routine loads app if found and starts it with (eval (read (strcat "C:" "Myapp"))) ;;; have fun ;;; ------------------------------ ;;; ;;; |S1 S2| ;;; ;;; | -------------- ----- [a]| ;;; ;;; | |E1 E2| [b]| ;;; ;;; | | | [c]| ;;; ;;; | | | [d]| ;;; ;;; | |E3 E4| [e]| ;;; ;;; | -------------------- [f]| ;;; ;;; |S3 S4| ;;; ;;; ------------------------------ ;;; ;;; (count_calcula) : ;;; values are effected by resize window : vc , vs , ss , x+ , x- , y+ , y- , P1-P4 ;;; screen corner points : S1 = (x- y+) , S2 (x+ y+) , S3 (x- y-) , S4 (x+ y-) ;;; extents corner points : E1 - E5 extmin / extmax ;;; viewsize : vs - height current viewport (drawing units) (i.e. 300 / 386 after resize) ;;; screen size : ss (1187 532) (pixels) after max acad window : vs = 386 , ss = (1840 685) ;;; - 12 rows, 1-10 for user , 11 for confid , 12 for exit ;;; - height each row = (fix (/ (- y+ y-) 12)) , for example 25 ;;; - row width = row height , lets call it cell-size ;;; cell-ip = (list (- (fix x+) cell-size) (fix y+)) ;;; vector draw cell-ip -> cell-size<0, (* cell-size 12)<270 , cell-size<180 , (* cell-size 12)<90 (defun draw_menu ( / ip-x ip-y cell-h cell-w cell-ul cell-ll cell-ur cell-lr y-list ctr-x app-list app gr-loop tblc tbtc) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare" "Config" "Quit")) (setq gr-loop T tblc 7 tbtc 7) ;;; toolbar line color / toolbar text colot (redraw_menu) ;;; launch app (if app (RlxGrMenu_Start_App app)) ) (defun redraw_menu () (redraw) ;;; get live screen data (count_calcula) ;(setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare" "Config" "Quit")) ;(setq cell-h (fix (/ (- y+ y-) 12)) cell-w (* cell-h 2)) ;;;; corner points ;(setq cell-ul (list (- (fix x+) cell-w) (fix y+)) cell-ur (list (fix x+) (fix y+)) ; cell-ll (list (- (fix x+) cell-w) (fix y-)) cell-lr (list (fix x+) (fix y-))) (setq cell-h (/ (- y+ y-) 12) cell-w (* cell-h 2)) ;;; corner points (setq cell-ul (list (- x+ cell-w) y+) cell-ur (list x+ y+) cell-ll (list (- x+ cell-w) y-) cell-lr (list x+ y-)) ;;; draw the outlines (grdraw cell-ll cell-ul tblc)(grdraw cell-ul cell-ur tblc)(grdraw cell-ur cell-lr tblc)(grdraw cell-lr cell-ll tblc) ;;; get y values for all horizontal separators (setq x-list (list (car cell-ll) (car cell-lr)) y-list (gnl- (- (fix y+) cell-h) 11 cell-h)) (foreach y y-list (grdraw (list (car cell-ll) y) (list (car cell-lr) y) tblc)) ;;; label the cell (setq ctr-x (+ (car cell-ll) (* cell-w 0.5))) (mapcar '(lambda (s y) (grtxt (strcase s) (list ctr-x (+ y (* cell-h 0.5))) tbtc 0 "M")) app-list (append y-list (list (- (last y-list) cell-h)))) (if gr-loop (RlxGrMenu_Get_Cell_ID x-list y-list)) (princ) ) ;;; (re) calculate display parameters (count_calcula) (defun count_calcula () (setq vc (getvar "VIEWCTR") vs (getvar "VIEWSIZE") ss (getvar "SCREENSIZE") dx (* vs (/ (car ss) (cadr ss)) 0.5) dy (* vs 0.5) x- (- (car vc) dx) y- (- (cadr vc) dy) x+ (+ (car vc) dx) y+ (+ (cadr vc) dy) ip (getvar "viewctr") vc-x (car ip) vc-y (cadr ip) txt-h (/ (getvar "VIEWSIZE") 100.0))) ;;; (getvar "extmin") (getvar "extmax") (setq dvx (- x+ x-) dvy (- y+ y-)) (defun screen_res (/ s i is) (setq s (vlax-invoke (vlax-create-object "WbemScripting.SWbemLocator") 'ConnectServer nil nil nil nil nil nil nil) is (vlax-invoke s 'ExecQuery "SELECT CurrentHorizontalResolution, CurrentVerticalResolution FROM Win32_VideoController")) (vlax-for i is (vlax-get i 'CurrentHorizontalResolution))) ;;; get aspect ratio current screen (defun asp_rat () (rtos (* 1.5 (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))))) ;;; determine status caps lock for when typing filter (even though filter uses strcase) (defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "") ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s))))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ;;; i = startnumber n = number of numbers , d = difference (gnl- 100 6 12) -> (100 88 76 64 52 40) (defun gnl- (i n d / l) (setq l (list i))(repeat (1- n)(setq l (cons (setq i (- i d)) l)))(reverse l)) ;;; found this old lisp (grtxt.lsp) , don't know author but all credits are for this human from earth ;;; text string / coordinate point / color / angle justificationz ;;; *** UPPER CASE ONLY *** (grtxt (STRCASE "Rob") (getvar "viewctr") 1 0 "M") (defun grtxt (ts cp cl a j / vp ltb i xp z c p1 p2 lp ld n al) ;;; vertex points (setq vp '(( 1 ( 0.50 0.25))( 2 ( 0.50 0.55))( 3 ( 0.50 0.85))( 4 ( 0.50 1.00))( 5 ( 0.25 1.00)) ( 6 ( 0.00 1.00))( 7 (-0.25 1.00))( 8 (-0.50 1.00))( 9 (-0.50 0.85))(10 (-0.50 0.55)) (11 (-0.50 0.25))(12 (-0.50 0.10))(13 (-0.25 0.10))(14 ( 0.00 0.10))(15 ( 0.25 0.10)) (16 ( 0.50 0.10))(17 ( 0.50 -0.05))(18 ( 0.50 -0.45))(19 ( 0.50 -0.85))(20 ( 0.50 -1.00)) (21 ( 0.25 -1.00))(22 ( 0.00 -1.00))(23 (-0.25 -1.00))(24 (-0.50 -1.00))(25 (-0.50 -0.85)) (26 (-0.50 -0.40))(27 (-0.50 -0.05))(30 ( 0.35 0.85))(31 (-0.35 0.85))(32 (-0.35 -0.85)) (33 ( 0.35 -0.85))(40 ( 0.25 0.35))(41 (-0.25 0.35))(42 ( 0.25 -0.15))(43 (-0.25 -0.15)) (44 ( 0.00 0.45))(45 ( 0.00 -0.25))(50 ( 0.30 0.20))(51 ( 0.30 0.35))(52 ( 0.20 0.35)) (53 ( 0.20 0.20))(54 ( 0.30 0.10))(55 ( 0.30 -0.10))(56 ( 0.20 -0.10))(57 ( 0.20 0.10)) (60 (-0.30 0.20))(61 (-0.30 0.35))(62 (-0.20 0.35))(63 (-0.20 0.20))(64 (-0.30 0.10)) (65 (-0.30 -0.10))(66 (-0.20 -0.10))(67 (-0.20 0.10)))) ;;; letter table (setq ltb '(("A" 24 9 7 5 3 20 16 12) ("B" 12 15 1 3 5 8 24 21 19 17 15) ("C" 3 5 7 9 25 23 21 19) ("D" 3 5 8 24 21 19 3) ("E" 4 8 12 15 12 24 20) ("F" 4 8 12 15 12 24) ("G" 3 5 7 9 25 23 21 19 16 14) ("H" 20 -4 8 -24 16 12) ("I" 7 5 6 22 23 21) ("J" 4 19 21 23 25) ("K" 8 24 12 13 4 13 20) ("L" 8 24 20) ("M" 24 8 14 4 20) ("N" 24 8 20 4) ("O" 3 5 7 9 25 23 21 19 3) ("P" 12 15 1 3 5 8 24) ("Q" 3 5 7 9 25 23 21 19 3 -19 20 45) ("R" 20 14 12 15 1 3 5 8 24) ("S" 3 5 7 9 11 13 15 17 19 21 23 25) ("T" 4 8 6 22) ("U" 8 25 23 21 19 4 20) ("V" 8 22 4) ("W" 8 23 14 21 4) ("X" 4 -24 8 20) ("Y" 8 14 22 14 4) ("Z" 8 4 24 20) ("0" 3 5 7 9 25 23 21 19 -3 4 24) ("1" 31 7 6 22 21 23) ("2" 9 7 5 3 1 15 13 27 24 20) ("3" 9 7 5 3 1 15 13 15 17 19 21 23 25) ("4" 8 12 16 15 5 21) ("5" 4 8 12 15 17 19 21 23 25) ("6" 3 5 7 9 25 23 21 19 17 15 12) ("7" 8 4 22) ("8" 3 5 7 9 11 13 27 25 23 21 19 17 15 13 15 1 3) ("9" 25 23 21 19 3 5 7 9 11 13 16) ("<" 4 12 20) (">" 8 16 24) ("," 33 21) ("." 19 20 21 33 19) ("\'" 4 30) ("\"" 4 -30 7 31) (";" 50 51 52 53 -50 54 55 56 57 55 45) (":" 50 51 52 53 -50 54 55 56 57 55) ("\\" 8 20) ("/" 4 24) ("?" 11 10 7 5 2 1 45 22) ("|" 6 -44 45 22) ("+" 44 -45 13 15) ("=" 40 -41 43 42) ("-" 13 15) ("_" 20 24) (")" 6 2 18 22) ("(" 6 10 26 22) ("*" 40 -43 41 -42 45 44) ("&" 21 31 7 6 26 25 23 16) ("^" 10 6 2) ("%" 57 54 55 56 -57 63 60 61 62 -63 5 24) ("$" 3 5 7 9 11 13 15 17 19 21 23 25 -26 22 6) ("#" 24 -6 22 -4 1 -11 17 27) ("@" 42 15 40 44 41 13 43 45 42 17 3 5 7 9 25 23 21 19) ("!" 6 -45 22 22) ("~" 9 31 44 40 2) ("`" 8 31) ("[" 6 8 24 22) ("]" 6 4 20 22) ("{" 6 7 41 12 43 23 22) ("}" 6 5 40 16 42 21 22) (""))) ;;; text height (setq z (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")) 0.2)) (cond ;;; left justification ((eq (strcase (substr j 1 1)) "L") (setq xp (list (+ (car cp) z) (cadr cp)) i 1)) ;;; middle justification ((eq (strcase (substr j 1 1)) "M") (setq xp (list (- (car cp) (* z (strlen ts) 0.5)) (cadr cp)) i 1)) ;;; right justification ((eq (strcase (substr j 1 1)) "R") (setq xp (list (- (car cp) (* z (strlen ts) 1.5)) (cadr cp)) i 1)) ) (repeat (strlen ts) ;;; each charachter / line point list / letter point def (setq c (substr ts i 1) lp '() ld (cdr (assoc c ltb))) (while (> (length ld) 1) (setq p1 (cadr (assoc (abs (nth 0 ld)) vp)) p2 (cadr (assoc (abs (nth 1 ld)) vp)) p1 (mapcar '* (list z z) p1) p2 (mapcar '* (list z z) p2) p1 (mapcar '+ xp p1) p2 (mapcar '+ xp p2) lp (append lp (list (if (minusp (nth 0 ld)) 0 cl) p1 p2)) ld (cdr ld)) ) ;;; add rotation angle (setq n 0 al nil) (repeat (/ (length lp) 3) (setq al (cons (nth n lp) al) al (cons (polar cp (+ a (angle cp (nth (+ n 1) lp))) (distance cp (nth (+ n 1) lp))) al) al (cons (polar cp (+ a (angle cp (nth (+ n 2) lp))) (distance cp (nth (+ n 2) lp))) al)) (setq n (+ n 3)) ) (and al (grvecs (reverse al))) (setq xp (list (+ (car xp) (* z 1.5)) (cadr xp)) i (1+ i)) ) (prin1) ) ;;; probably won't need tracking mode (cut-copy-paste you know...) (defun RlxGrMenu_Get_Cell_ID (xl yl / inp dev tpt prev-tpt mark-current-tracking-point cell-id prev-cell-id prev-view-size cur-view-size rtn) (princ "\rEsc/Q/Rmouse to cancel, zoom with E(extend), Z(oom) or + / -") (setq prev-view-size (getvar "viewsize")) (while gr-loop (setq cur-view-size (getvar "viewsize")) (setq inp (vl-catch-all-apply 'grread (list T 8 1))) (if (vl-catch-all-error-p inp) (progn (setq gr-loop nil inp nil)(redraw)) (progn (setq dev (car inp) tpt (cadr inp)) (cond ;;; space , q or Q (Quit) ((and (= dev 2) (member (last inp) '(32 113 81))) (redraw)(setq gr-loop nil) ) ;;; point selection (3 (221.882 173.853 0.0)) ((= dev 3) (if (setq rtn (find_cell tpt xl yl)) (progn ;(alert (setq app (nth (1- (atoi rtn)) app-list))) (princ (strcat "\nLaunching : " (setq app (nth (1- (atoi rtn)) app-list)))) (setq gr-loop nil) ) ) ) ;;; device tracking point (probably don't need tracking mode) ((= dev 5) ;;; if mouse moved (if (or (/= (car prev-tpt)(car tpt)) (/= (cadr prev-tpt)(cadr tpt))) (progn (setq prev-tpt tpt ))) (if (not (equal cur-view-size prev-view-size)) (progn (setq prev-view-size cur-view-size) (redraw_menu) ) ) ) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (redraw)(setq gr-loop nil app "Quit")) ; user pressed + ((equal inp '(2 43)) (vl-cmdf "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (vl-cmdf "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (vl-cmdf "'zoom" "")) ) ) ) ) (princ) ) ;;; pt = point , xl = x-list , yl = y-list ;;; scribble : (< 1 2 3) , (> 3 2 1) , (cdr (vl-sort '(1 2 3 4 5) '>)) -> '(4 3 2 1) (defun find_cell ( pt xl yl / ptx pty y-lst l n hit) (setq n nil hit nil ptx (car pt) pty (cadr pt) y-list (vl-sort (append yl (list 0)) '>)) (if (< (car xl) ptx (cadr xl)) (mapcar '(lambda (y)(if (and (not hit) (> pty y)) (setq hit T n (vl-position y y-list)))) y-list)) (if n (itoa (1+ n))) ) ;;; program assumes no self starting routines and start command is "C:" + app name (defun RlxGrMenu_Start_App (app / fn) (cond ((setq fn (findfile (strcat app ".lsp"))) (redraw)(load fn)(eval (read (strcat "(C:" app ")")))) ((wcmatch (strcase app) "QUIT")(princ "\nBye bye")(redraw)) ((wcmatch (strcase app) "CONFIG")(princ "\nUnder construction")(redraw)) (t (redraw)(princ (strcat "\nUnable to load " (vl-princ-to-string app) " ...bye"))) ) (princ) ) ;;; future... ;;; RlxGrMenu - Rlx Jul/25 (defun RlxGrMenu_future ( / ;;; global variables scr-res cell-rows cell-cols cell-col cell-id app-list ;;; display parameters like viewctr/viewsize/screensize (count_calcula) vc vs ss dx dy x- x+ y- y+ ip vc-x vc-y txt-h ;;; registry variables RlxGrMenu-nof-cell-rows RlxGrMenu-nof-cell-cols RlxGrMenu-app-list ) ;;; mostly not used because for now I just just one column with 10 rows (setq scr-res (screen_res) rows 3 cols 3 cell-col 141 cell-id 1) (count_calcula) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare")) (RlxGrMenu_Init) (RlxGrMenu_Doit) (RlxGrMenu_Exit) (princ) ) (defun RlxGrMenu_Init ()(princ "\nUnder construction - RlxGrMenu_Init ")) (defun RlxGrMenu_Doit ()(princ "\nUnder construction - RlxGrMenu_Doit ")) (defun RlxGrMenu_Exit ()(princ "\nUnder construction - RlxGrMenu_Exit ")) (defun c:RlxGrMenu ()(draw_menu)) (defun c:t1 ()(draw_menu)) (defun t1 ()(draw_menu))

I use the technique frequently to achieve list box columns - for example, as used by the Content Builder dialog displayed by my Incremental Numbering Suite.

The biggest advantage to LISP solution is usability, very few people are allowed to load programs on their work computers, but most can download and run a LISP. @GLAVCVS latest works fine for me as of now. Right now I'm just getting a few things done for after I retire to help those behind me do things easier. I might just do a whole new take on a solution to this issue and have the user input the new diameters/radii, lengths, etc. and redraw it.

Everything can be improved But, IMO, there are two fundamental aspects in which Lisp code has a clear advantage over others: self-sufficiency and versatility. Self-sufficiency: because the code is able to resolve by itself (using the two platforms it has available—Windows and AutoCAD) all the needs it may encounter to solve a problem. Versatility: a *.lsp file is much more versatile and adaptable across versions (for obvious reasons) than a *.arx file. @dexus Therefore, if you write something entirely in Lisp that solves whatever you consider important, I will also applaud your code. (P.S.: Sometimes the .arx file that’s supposed to be valid for a certain version of AutoCAD doesn’t work—as you can see in the image.) I believe AutoCAD has made it this far not because its applications are particularly fast or slow, but because it gives the user a great deal of freedom in handling drawing objects. Someone said in another thread on this forum that AutoCAD will eventually stop supporting Visual Lisp. The day that happens, I know many who will stop using AutoCAD and stick with whatever software best inherits its strengths. And I will be one of them.

I added a gray helper line so you can see how it edits curved segments. Maybe that makes it clearer what is happening and therefore more predictable. For me @GLAVCVS code is not as usefull since it doesn't keep tangent lines tangent when changing curves. It does work quite nicely on straight segments though.

Use the DCL tabs attribute and prefix the list items with a tab character ("\t").

One way, might be the easiest is to change the list that populates 'Block List', adding spaces to the nested block So you might have a line like this in your LISP: (start_list "lst" 3)(mapcar 'add_list BlockList)(end_list) Where BlockList is your list of block, might be (setq BlockList (list "BLOCK-1" "BLK-1" "BLK-2"... "BLOCK-2")) Which you could change to be (setq BlockList (list "BLOCK-1" " BLK-1" " BLK-2"... "BLOCK-2")) I don't think you can do the indenting with DCL, has to be done before then.

I've played with ElpanoxEvgeniy's original code and made a working version. It;s fine on straight segments but can be a little unpredictable on curved segments @GLAVCVS code is a bit more stable on curved segments.

Has anyone tried the code, got it working and find it useful?

Hi Indeed, any process started from AutoCAD will inherit its privilege level. For example, if AutoCAD opens an instance of Word, that instance will inherit the same privilege level as AutoCAD. However, if a Word instance is already running and AutoCAD starts controlling it, its privilege level might be different. In that case, it might be necessary to check it in order to warn the user. Could your issue be something similar to that? As @mhupp says, there is no direct way to determine this from VLisp. But there are some tricks to achieve it: For example: (defun acadAdmin? (/ arch r ruta ruta1 f sh) (if (findfile (setq ruta1 (strcat (getenv "TEMP") "\\acAdmin.si"))) (vl-file-delete ruta1) ) (if (setq arch (open (setq ruta (strcat (getenv "TEMP") "\\ea.bat")) "w")) (progn (write-line "@echo off net session >nul 2>&1 if %errorlevel% == 0 ( echo SI> \"%temp%\\acAdmin.si\" )" arch ) (close arch) (setq sh (vlax-create-object "WScript.Shell")) (vlax-invoke sh 'Run ruta 0 :vlax-true) (vlax-release-object sh) (vl-file-delete ruta) (if (setq r (findfile ruta1)) (progn (vl-file-delete ruta1) T ) ) ) ) ) This simply writes a .bat that when executed, creates the file "acAdmin.si" only if AutoCAD is running as admin

Sorry it took me a while to clean this up, it worked on your sample drawing. I was trying to get it to do any closed shape, but couldn't get Ellipses and Pline Ellipses to work. I'll get back to that when time allows. ;;; Trim (Lines & LWPolylines) Inside Closed Shapes (LWPolylines & Circles) = TICS | ;;; | ;;; https://www.cadtutor.net/forum/topic/98452-trim-lines-inside-rectangs/#findComment-674554 | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; TICS.lsp | ;;; | ;;; (Needs improvement, need to add Ellipses and Pline Ellipses to Shapes to trim with.) | ;;; | ;;;================================================================================================| (defun evenp (n) (= (rem n 2) 0)) (defun ent-in-ss (ent ss / i found) (setq found nil i 0 ) (while (and (< i (sslength ss)) (not found)) (if (equal ent (ssname ss i)) (setq found T) (setq i (1+ i)) ) ) found ) ;; Ray casting algorithm for closed LWPolyline. (defun point-inside-polygon (pt plObj / crossings i paramCount p1 p2) (setq crossings 0) (setq pCount (fix (vlax-curve-getEndParam plObj))) (setq i 0) (while (< i pCount) (setq p1 (vlax-curve-getPointAtParam plObj i)) (setq p2 (vlax-curve-getPointAtParam plObj (1+ i))) (if (and (> (cadr pt) (min (cadr p1) (cadr p2))) (<= (cadr pt) (max (cadr p1) (cadr p2))) (< (car pt) (+ (car p1) (* (- (cadr pt) (cadr p1)) (/ (- (car p2) (car p1)) (- (cadr p2) (cadr p1))) ) ) ) ) (setq crossings (1+ crossings)) ) (setq i (1+ i)) ) (not (evenp crossings)) ) ;;;================================================================================================| (defun c:TICS (/ ssShapes ssLines i j ent entObj shapeEnt shapeObj shapeType pts allIntPts p1 p2 mid inside? origColor ) (vl-load-com) (prompt "\n--- Trim Lines & LWPolylines Inside Circles & Closed LWPoplylines ---\n" ) ;; Prompt to select shapes for trimming (prompt "\nSelect closed polylines or circles as trimming boundaries:" ) (setq ssShapes (ssget '((0 . "LWPOLYLINE,CIRCLE")))) (if (not ssShapes) (progn (prompt "\nNo valid trimming shapes selected.") (exit)) ) ;; Select all lines and polylines in drawing (setq ssLines (ssget "X" '((0 . "LINE,LWPOLYLINE")))) (if (not ssLines) (progn (prompt "\nNo lines or polylines found to trim.") (exit)) ) (setq i 0) (while (< i (sslength ssLines)) (setq ent (ssname ssLines i)) (if (not (ent-in-ss ent ssShapes)) (progn (setq entObj (vlax-ename->vla-object ent)) (setq origColor (vla-get-Color entObj)) ;; Collect intersection points with all shapes (setq allIntPts '()) (setq j 0) (while (< j (sslength ssShapes)) (setq shapeEnt (ssname ssShapes j)) (setq shapeObj (vlax-ename->vla-object shapeEnt)) (setq shapeType (cdr (assoc 0 (entget shapeEnt)))) (if (or (= shapeType "LWPOLYLINE") (= shapeType "CIRCLE")) (progn (setq pts (vlax-invoke shapeObj 'IntersectWith entObj acExtendNone ) ) (if (and pts (> (length pts) 2)) (progn (repeat (/ (length pts) 3) (setq allIntPts (append allIntPts (list (list (car pts) (cadr pts) (caddr pts) ) ) ) ) (setq pts (cdddr pts)) ) ) ) ) ) (setq j (1+ j)) ) (if (null allIntPts) (progn (setq mid (cond ((= (vla-get-objectname entObj) "AcDbLine") (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (vlax-get entObj 'StartPoint) (vlax-get entObj 'EndPoint) ) ) ((= (vla-get-objectname entObj) "AcDbPolyline") (vlax-curve-getPointAtDist entObj (/ (vlax-curve-getDistAtParam entObj (vlax-curve-getEndParam entObj) ) 2.0 ) ) ) (T nil) ) ) (setq inside? nil) (setq j 0) (while (and (< j (sslength ssShapes)) (not inside?)) (setq shapeEnt (ssname ssShapes j)) (setq shapeObj (vlax-ename->vla-object shapeEnt)) (setq shapeType (cdr (assoc 0 (entget shapeEnt)))) (setq inside? (cond ((= shapeType "LWPOLYLINE") (point-inside-polygon mid shapeObj) ) ((= shapeType "CIRCLE") (< (distance mid (vlax-get shapeObj 'Center)) (vlax-get shapeObj 'Radius) ) ) (T nil) ) ) (setq j (1+ j)) ) (if inside? (entdel ent) ) ) (progn (setq allIntPts (append (list (vlax-curve-getStartPoint ent)) allIntPts (list (vlax-curve-getEndPoint ent)) ) ) (setq allIntPts (vl-sort allIntPts (function (lambda (a b) (< (vlax-curve-getDistAtPoint ent a) (vlax-curve-getDistAtPoint ent b) ) ) ) ) ) (entdel ent) (setq j 0) (while (< j (1- (length allIntPts))) (setq p1 (nth j allIntPts)) (setq p2 (nth (1+ j) allIntPts)) (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)) (setq inside? nil) (setq k 0) (while (and (< k (sslength ssShapes)) (not inside?)) (setq shapeEnt (ssname ssShapes k)) (setq shapeObj (vlax-ename->vla-object shapeEnt)) (setq shapeType (cdr (assoc 0 (entget shapeEnt)))) (setq inside? (cond ((= shapeType "LWPOLYLINE") (point-inside-polygon mid shapeObj) ) ((= shapeType "CIRCLE") (< (distance mid (vlax-get shapeObj 'Center) ) (vlax-get shapeObj 'Radius) ) ) (T nil) ) ) (setq k (1+ k)) ) (if (not inside?) (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 62 origColor) ) ) ) (setq j (1+ j)) ) ) ) ) ) (setq i (1+ i)) ) (prompt "\nDone trimming inside shapes.") (princ) ) (princ "\nType 'TICS' to run the command.")

Aj, unlucky. Hopefully Alexander Rivilis will make an updated version for newer versions!