Leaderboard

This is not correct. Entities within the database are being modified, but the database is not being 'rearranged'. The reason that the loop does not terminate is because the equality & inequality operators work with strings & numerical data types, whereas the variables en & enlast are entity names (essentially pointers). As such, when comparing the pointers, the operators are not comparing the data to which they point, but the pointers themselves - this can be confirmed with the following simple test: _$ (setq e2 (entlast)) <Entity name: 2e2aabd68a0> _$ (setq e1 (car (entsel))) <Entity name: 2e2aabd68a0> Observe that variables e1 & e2 point to the same entity data, but have been created separately. When using the equality or inequality operators, the memory addresses of the pointers themselves are being compared, which are not equal: _$ (= e1 e2) nil _$ (/= e1 e2) T If we copy the pointer, the address will now be equal: _$ (setq e3 e1) <Entity name: 2e2aabd68a0> _$ (= e1 e3) T Instead, we should use the eq function to compare the data to which the pointers point: _$ (= e1 e2) nil _$ (eq e1 e2) T As such, the code could potentially be written: (defun c:tf ( / ed1 ed2 en enlast ) (setq enlast (entlast) en (entnext) ) (while (not (eq en enlast)) (setq ed1 (entget en) ed2 nil ) (if (= "LWPOLYLINE" (cdr (assoc 0 ed1))) (progn (foreach x ed1 (if (= 10 (car x)) (setq ed2 (append ed2 (list (list 10 (+ 100 (cadr x)) (+ 100 (caddr x)))))) (setq ed2 (append ed2 (list x))) ) ) (entmod ed2) ) ) (setq en (entnext en)) ) (princ) ) However, note that this will not operate on the last entity added to the database, and so to include it, we could write the code as: (defun c:tf ( / ed1 ed2 en ) (setq en (entnext)) (while en (setq ed1 (entget en) ed2 nil ) (if (= "LWPOLYLINE" (cdr (assoc 0 ed1))) (progn (foreach x ed1 (if (= 10 (car x)) (setq ed2 (append ed2 (list (list 10 (+ 100 (cadr x)) (+ 100 (caddr x)))))) (setq ed2 (append ed2 (list x))) ) ) (entmod ed2) ) ) (setq en (entnext en)) ) (princ) )

Here's a quick one - (defun c:dimsub ( / enx grp idx new pos sel str ) (cond ( (= "" (setq str (getstring t "\nSpecify string: ")))) ( (setq sel (ssget "_:L" '((0 . "*DIMENSION")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) grp (assoc 1 enx) ) (if (setq pos (vl-string-search "\\X" (cdr grp))) (setq new (cons 1 (strcat (substr (cdr grp) 1 pos) "\\X" str))) (setq new (cons 1 (strcat "<>\\X" str))) ) (entmod (subst new grp enx)) ) ) ) (princ) )

I think this is what you want. There were a bunch of things wrong ;; a function that reads the coordinates of the vertices of a selected POLYLINE / LWPOLYLINE (defun getPolylineVertexes ( pline / lst i res) (setq lst (vlax-get (vlax-ename->vla-object pline) 'coordinates)) (setq i 0) (setq res (list)) (repeat (/ (length lst) 2) (setq res (append res (list (list (nth i lst) (nth (+ i 1) lst) ) ))) (setq i (+ i 2)) ) res ) (defun c:angdeg_ln_lwln ( / selEnt entData objType coords p1 p2 ang angDeg mid v offsetVector offsetDist insPoint txtHeight txtStr x y ) (setq selEnt (car (entsel "\nSelect LINE or LWPOLYLINE: "))) (cond ((null selEnt) (prompt "\nNo lines or polylines are selected..") ) (t (setq entData (entget selEnt) objType (cdr (assoc 0 entData)) ) (cond ;; switch on the type of selected object ;; ********* LINE ************ ( (eq objType "LINE") (setq p1 (cdr (assoc 10 entData)) p2 (cdr (assoc 11 entData))) ) ;; *********** LWPOLYLINE ********** ((eq objType "LWPOLYLINE") (setq coords (getPolylineVertexes selEnt)) ;;(princ coords) (if (>= (length coords) 2) (progn (setq p1 (nth 0 coords) p2 (nth 1 coords))) (prompt "\nNot enough vertices in the polyline.") ) ;;(princ p1) ;;(princ p2) ) ;; ********** Other type of object ********* (t (prompt (strcat "\nAn object has been selected" objType ",but expected LINE or LWPOLYLINE.")) (return) ) ) ;; angle (if (and p1 p2) (progn (setq ang (angle p1 p2) angDeg (* ang (/ 180.0 pi)) ; radians -> degrees ) ;;The middle of the segment (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)) ;;Vector p1 p2 (setq v (list (- (nth 0 p2) (nth 0 p1)) (- (nth 1 p2) (nth 1 p1)))) ;; Perpendicular to this vector (x, y) => (y, -x) (setq offsetVector (list (nth 1 v) (- (nth 0 v)))) ;; Offset (setq offsetDist 0.5) (defun normalize (vec) (setq len (distance '(0 0) vec)) (if (> len 1e-9) (list (/ (car vec) len) (/ (cadr vec) len)) vec ) ) (setq offsetVector (normalize offsetVector)) (setq offsetVector (mapcar '(lambda (x) (* x offsetDist)) offsetVector)) ;; The end point of text insertion (setq insPoint (mapcar '+ mid offsetVector)) (setq txtStr (rtos angDeg 2 2)) (setq txtHeight 2.5) (command "_.TEXT" "_M" insPoint txtHeight 0.0 txtStr) (prompt (strcat "\nTilt angle: " txtStr "°")) ) ) ) ) (princ) )

FWIW, I might be inclined to write the program as follows - (defun c:tf ( / i s ) (if (setq s (ssget "_X" '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength s)) (entmod (mapcar '(lambda ( x ) (if (= 10 (car x)) (mapcar '+ x '(0 100 100)) x)) (entget (ssname s (setq i (1- i)))) ) ) ) ) (princ) )

Give this a try, it has the sort selection order using fence, it has no error checking, relies on the pline on a different layer to the cut lines. It also caps the ends I guess you want to make all the bits into a pline. ; https://www.cadtutor.net/forum/topic/96685-intersection/ ; do by fence a 1st attempt by AlaH March 2025 (defun c:pltrim ( / plent co-ord obj obj2 ss intpt dist lst osnap lay lay2) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq lst '()) (setq off (getreal "\nEnter offset value ")) (princ "\nPick points for fence line selection ") (command-s "pline") (setq plent (entlast)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))) (command "erase" plent "") (setq ss (ssget "F" co-ord '((0 . "LINE")))) (setq lay (cdr (assoc 8 (entget (ssname ss 0))))) (if (= (getvar 'clayer) lay) (command "-layer" "off" lay "Y" "") (command "-layer" "off" lay "") ) (setq plent (car (entsel "\nPick polyline "))) (setq obj (vlax-ename->vla-object plent)) (setvar 'clayer (vlax-get obj 'layer)) (repeat (setq x (sslength ss)) (setq l2 (ssname ss (setq x (1- x)))) (setq obj2 (vlax-ename->vla-object l2)) (setq intpt (vlax-invoke obj 'intersectwith obj2 acextendnone)) (setq dist (vlax-curve-getdistatpoint obj intpt)) (setq lst (cons (list dist intpt ) lst)) ) (setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y))))) (setq x 0) (setq lst2 '()) (setq lst2 (cons plent lst2)) (setq pt1 (cadr (nth x lst))) (setq pt2 (cadr (nth (1+ x) lst))) (command "break" pt1 pt2) (setq x (+ x 2)) (repeat (- (/ (length lst) 2) 1) (setq pt1 (cadr (nth x lst))) (setq pt2 (cadr (nth (1+ x) lst))) (command "break" pt1 pt2) (setq lst2 (cons (entlast) lst2)) (setq x (+ x 2)) ) (foreach ent lst2 (setq eobj (vlax-ename->vla-object ent)) (vla-offset eobj off) (setq nobj (vlax-ename->vla-object (entlast))) (setq s2 (vlax-curve-getstartPoint nobj)) (setq e2 (vlax-curve-getendpoint nobj)) (setq s1 (vlax-curve-getstartpoint eobj)) (setq e1 (vlax-curve-getendpoint eobj)) (command "line" s1 s2 "") (command "line" e1 e2 "") ) (command "-layer" "on" lay "") (setvar 'osmode oldsnap) (princ) )