maahee Posted March 3 Posted March 3 (edited) (defun C:BM () (setq poly (car (entsel "\nSelect any LWpolyline (for offset)..."))) (setq line (car (entsel "\nSelect a line to break..."))) (setq dist (getreal "\nEnter the offset distance: ")) (setq g (getreal "\nEnter the gap: ")) (if (and poly line) ; Ensure both selections are made (progn (setq pdb (entget poly)) (if (= (cdr (assoc 0 pdb)) "LWPOLYLINE") ; Check if the entity type is LWPOLYLINE (progn (setq ps '()) (setq pt1 nil) ;; Extract vertex points from the polyline (foreach sublist pdb (if (= (car sublist) 10) ; Look for vertex points (coded as 10) (if (null pt1) (setq pt1 (cdr sublist)) ;; First vertex (progn (setq pt2 (cdr sublist)) ;; Next vertex (setq ps (append ps (list pt1 pt2))) ; Append points to the list (setq pt1 pt2) ;; Update pt1 for the next iteration ) ) ) ) (command "_.offset" dist poly "@1<90" "") ;; Get the start and end points of the line (setq typ (entget line)) (setq p1 (cdr (assoc 10 typ))) ; Start point of the line (setq p2 (cdr (assoc 11 typ))) ; End point of the line ;; Find intersection point (setq kl (inters p1 p2 (nth 0 ps) (nth 1 ps))) (if kl (progn (command "_break" poly kl (mapcar '+ kl (list g 0 0))) (command "line" kl (mapcar '+ kl (list g 0 0)) "") ) (prompt "\nNo intersection found.") ) ) ;; End progn for LWPOLYLINE ) ;; End if for LWPOLYLINE type ) ;; End progn for both selections (prompt "\nPlease select both a polyline and a line.") ) ;; End if for selection ) ;; End defun I can not find the intersection point polyline in blue and line red colors. gives suggestion and ideas 1l.pdf Edited March 3 by maahee Quote
GLAVCVS Posted March 3 Posted March 3 The answer is simple: the first segment of the polyline does not intersect the line. If, at first glance, you can see that the line intersects the polyline, it means that it does so in another segment, but not in the first one. 1 Quote
GLAVCVS Posted March 3 Posted March 3 Your code should advance through the list of points on the polyline until it finds the segment that intersects the line. 1 Quote
GLAVCVS Posted March 3 Posted March 3 But there is another, simpler way to get the intersection, which makes the part of your code that gets the lists of points unnecessary: 'vla-intersectWith' Simply replace the line of code that starts with '(setq kl (inters ...))' with... (setq kl (safearray-value (variant-value (vla-intersectWith (vlax-ename->vla-object poly) (vlax-ename->vla-object line) 0)))) 1 Quote
BIGAL Posted March 3 Posted March 3 A couple of ideas use a (ssget "F" where you drag a line through all the red cut lines this should return them in correct order, pick pline, do offset, and then as suggested can do the pairs break. I would also check is the number of cut lines even if not then dont run. You need to do the break twice inner and outer pline so 4 points can then cap as well. Will have a think about it. Just a ps (setq intpt1 (vlax-invoke obj2 'intersectWith obj acextendnone)) returns (58.111571345732 222.717516115398 0.0) No need for the safe array 1 Quote
maahee Posted March 6 Author Posted March 6 (edited) selection method for the correct order, ssget "F" effectively works but it has some limitations I am using this (setq ss (ssget)) method then separate line and polyline 1l.pdf Edited March 6 by maahee Quote
BIGAL Posted March 7 Posted March 7 (edited) 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) ) Edited March 7 by BIGAL 1 Quote
maahee Posted March 10 Author Posted March 10 (defun c:bmm() (setq x-distance (getdist "\nEnter distance to separate polylines in X direction: ")) ; Prompt user for X distance (setq y-distance (getdist "\nEnter distance to separate polylines in Y direction: ")) ; Prompt user for Y distance (setq ss (ssget '((0 . "LWPOLYLINE"))) ; Select all polylines count (sslength ss) ; Get number of polylines newPos nil) ; Initialize variable for new positions (if (and ss (> count 1)) (progn (setq i 0) (repeat count (setq ent (ssname ss i)) ; Get entity name of each polyline (setq pt (vlax-curve-getstartpoint ent)) ; Get start point of the polyline (setq newPos (list (+ (car pt) (* i x-distance)) ; Calculate new X position (+ (cadr pt) (* i y-distance)) ; Calculate new Y position (caddr pt))) ; Keep Z position the same (command "_move" ent "" pt newPos) ; Move the polyline to the new position (setq i (1+ i)) ; Increment index ) ) (princ "\nNo polyline selected.") ) (princ) ) bm.pdf Quote
BIGAL Posted March 10 Posted March 10 For me just ask Length & Height, offset +ve or -ve for in / out, how many rows, how many columns and draw it. Get a copy of my Muti getvals.lsp here in Downloads can do front end for you. 1 Quote
maahee Posted March 10 Author Posted March 10 (edited) 45 minutes ago, BIGAL said: For me just ask Length & Height, offset +ve or -ve for in / out, how many rows, how many columns and draw it. Get a copy of my Muti getvals.lsp here in Downloads can do front end for you. row and column pick from the drawing and it is also not the same object number in row and column object number which can be variable, I want to study getvals.lsp Edited March 10 by maahee Quote
maahee Posted March 15 Author Posted March 15 (edited) (defun c:bmm () (setq x-distance (getdist "\nEnter distance to separate polylines in X direction: ")) (setq y-distance (getdist "\nEnter distance to separate polylines in Y direction: ")) ;; Select all polylines and get the number of selected entities (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq count (sslength ss)) (setvar 'osmode 0) ;; Check if there are multiple polylines selected (if (and ss (> count 1)) (progn ;; Initialize variables (setq i 0) (setq j 0) (setq k 0) (setq n 0) (setq h 0) ;; Iterate over the selected polylines (repeat count (setq ent (ssname ss i)) ; Get entity name of each polyline (setq pt (vlax-curve-getstartpoint ent)) ; Get start point of the polyline ;; Check if the x coordinate has changed (if (= (car pt) (car (vlax-curve-getstartpoint (ssname ss j)))) (progn (setq j i) (setq k 0) ) ) (if (/= (car pt) (car (vlax-curve-getstartpoint (ssname ss n)))) (progn (setq n i) (setq h 0) ) ) ;; Calculate new position (setq newPos (list (- (car pt) (* k x-distance)) ; Calculate new X position (+ (cadr pt) (* h y-distance)) ; Calculate new Y position (caddr pt))) ; Keep Z position the same ;; Move the polyline to the new position (command "_move" ent "" pt newPos) ;; Increment indices (setq i (1+ i)) (setq k (1+ k)) (setq h (1+ h)) ) ;; Print success message (princ "\nPolylines moved apart successfully.") ) (progn ;; Print error message (princ "\nNo suitable polylines found or only one polyline selected.") ) ) (setvar 'osmode 511) (princ) ) I can not create space between objects on the y-axisdirection test.dwg Edited March 15 by maahee Quote
GLAVCVS Posted March 17 Posted March 17 Hi Maahee I think it's hard to know what your code is supposed to do. Without knowing this, it's hard to get anyone to respond to you. 1 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.