Leaderboard

Here, try this revision... (defun c:lwlines-blks ( / mid car-sort online ch ss i blks ll ur plst p pp ppp sppp mp rtn k x n r li li1 li2 ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun mid ( p1 p2 ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2) ) (defun car-sort ( lst func / itm rtn ) (setq itm (car lst)) (foreach a (cdr lst) (if (apply func (list a itm)) (setq itm a rtn a) (setq rtn itm) ) ) rtn ) (defun online ( p1 p p2 ) (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6) ) (initget 1 "Left Right") (setq ch (getkword "\nChoose side from where to trim 4 pieces of blocks [Left / Right] : ")) (initget 7) (setq n (getint "\nSpecify how many blocks you want to skip per each row : ")) (initget 7) (setq r (getint "\nSpecify how many blocks are in each row : ")) (if (setq ss (ssget (list (cons 0 "INSERT")))) (repeat (setq i (sslength ss)) (setq blks (cons (ssname ss (setq i (1- i))) blks)) ) ) (foreach blk blks (vla-getboundingbox (vlax-ename->vla-object blk) (quote ll) (quote ur)) (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur))) (setq plst (cons (mid ll ur) plst)) ) (setq p (car-sort plst (function (lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b))))))) (setq rtn (cons p rtn)) (while plst (setq plst (vl-remove p plst)) (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b)))))) (progn (setq rtn (cons pp rtn)) (setq p pp) ) (progn (if plst (setq rtn (cons (car plst) rtn)) ) (setq plst nil) ) ) ) (setq rtn (reverse rtn)) (if (= ch "Left") (setq rtn (vl-remove-if (function (lambda ( p ) (< (car p) (if (not x) (setq x (car (nth n rtn))) x)))) rtn)) ) (if (= ch "Right") (setq rtn (vl-remove-if (function (lambda ( p ) (> (car p) (if (not x) (setq x (car (nth (- r n 1) rtn))) x)))) rtn)) ) (setq ppp rtn) (setq p (car rtn)) (foreach pp (cdr rtn) (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)))) (progn (setq p pp) (setq rtn (vl-remove pp rtn)) ) (setq p pp) ) ) (setq k 1) (while rtn (setq k (1+ k)) (if (= 0 (rem k 2)) (setq li (list (car rtn) (cadr rtn))) (setq li (list (cadr rtn) (car rtn))) ) (setq mp (mid (car rtn) (cadr rtn))) (setq sppp (vl-sort ppp (function (lambda ( a b ) (< (distance mp a) (distance mp b)))))) (setq sppp (list (car sppp) (cadr sppp))) (setq li1 (list (car li) (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b))))))) (setq li2 (list (car-sort sppp (function (lambda ( a b ) (< (distance (cadr li) a) (distance (cadr li) b))))) (cadr li))) (setq rtn (cddr rtn)) (vl-cmdf "_.pline") (foreach p li1 (vl-cmdf "_non" p) ) (vl-cmdf "") (vl-cmdf "_.pline") (foreach p li2 (vl-cmdf "_non" p) ) (vl-cmdf "") ) (princ) ) HTH. Regards, M.R.

I find it hard to believe that the code doesn't work correctly in AutoCAD 2015. I have that version installed on another PC and it works perfectly. I think this is a good time for you to learn how to use the Visual Lisp debugger. With it you will be able to locate where the problem is and if, indeed, there is any inconsistency.

Just Google "entmake dimension autolisp"

@pondpepo9 I can't tell you if what you are looking for exists unless you can be more specific on what you want. Ideally, post a DWG with the Before and After and explain in more detail what the workflow should be. Then if someone has something they are willing to share, write, or alter - we can let you know. PLEASE NOTE: This is not a forum just to order up free programs. We prefer helping those who wish to learn programming and need a place to start, which is the purpose of this forum.

Thanks, BIGAL... I'll attach more complete version - it determines where picked point is and according to that it proceeds to draw snake to the opposite side of area between curves... M.R. snakefill-2curveboundaries.lsp

CafeJr, here try this and reply if something's wrong... It should now work with 2 opposite open 2d curve boundaries... (defun c:snakefill-2curveboundaries (/ *adoc* odd even osm pea ch r lpl upl ip dir lplo uplo spc xl1 c1 xl2 c2 cl ss) (defun odd (lst) (if lst (cons (car lst) (odd (cddr lst)))) ) (defun even (lst) (if lst (cons (cadr lst) (even (cddr lst)))) ) (vl-load-com) (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))) (setq osm (getvar 'osmode)) (setq pea (getvar 'peditaccept)) (setvar 'osmode 0) (command "_.ucs" "w") (initget 1 "Left-Right Up-Down") (setq ch (getkword "\nChoose option (Left-Right / Up-Down) curve boundaries: ")) (initget 7) (setq r (getdist "\nSpecify radius of snake turn: ")) (if (eq ch "Up-Down") (progn (setq lpl (car (entsel "\nPick lower curve boundary..."))) (setq upl (car (entsel "\nPick upper curve boundary..."))) (setq ip (getpoint "\nPick start point (\"left\" - Up-Down or \"bottom\" - Left-Right): ")) (initget 1 "Up Down") (setq dir (getkword "\nChoose start direction (Up / Down): ")) (if (eq dir "Up") (progn (command "_.offset" r lpl ip "") (setq lplo (entlast)) (command "_.offset" r upl ip "") (setq uplo (entlast)) (setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl)))) (setq c1 T c2 T k -3.0) (while (and c1 c2) (setq xl1 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (setq k (+ k 4.0)))) (polar (polar ip 0.0 (* r k)) (* pi 0.5) 1.0))) (setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object uplo) acextendnone)) (vla-delete xl1) (setq xl2 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (+ k 2.0))) (polar (polar ip 0.0 (* r (+ k 2.0))) (* pi 0.5) 1.0))) (setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object lplo) acextendnone)) (vla-delete xl2) (if c1 (setq cl (cons c1 cl))) (if (and c1 c2) (setq cl (cons c2 cl))) ) (setq cl (reverse cl)) (setq ss (ssadd)) (foreach c (vl-remove nil (odd cl)) (command "_.arc" (polar c pi r) (polar c (* pi 0.5) r) (polar c 0.0 r)) (ssadd (entlast) ss) ) (foreach c (vl-remove nil (even cl)) (command "_.arc" (polar c pi r) (polar c (* pi -0.5) r) (polar c 0.0 r)) (ssadd (entlast) ss) ) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (even cl)))) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (cdr (odd cl))))) (command "_.line" ip (polar (car cl) pi r) "") (ssadd (entlast) ss) ) (progn (command "_.offset" r lpl ip "") (setq lplo (entlast)) (command "_.offset" r upl ip "") (setq uplo (entlast)) (setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl)))) (setq c1 T c2 T k -3.0) (while (and c1 c2) (setq xl1 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (setq k (+ k 4.0)))) (polar (polar ip 0.0 (* r k)) (* pi 0.5) 1.0))) (setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object lplo) acextendnone)) (vla-delete xl1) (setq xl2 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (+ k 2.0))) (polar (polar ip 0.0 (* r (+ k 2.0))) (* pi 0.5) 1.0))) (setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object uplo) acextendnone)) (vla-delete xl2) (if c1 (setq cl (cons c1 cl))) (if (and c1 c2) (setq cl (cons c2 cl))) ) (setq cl (reverse cl)) (setq ss (ssadd)) (foreach c (vl-remove nil (odd cl)) (command "_.arc" (polar c pi r) (polar c (* pi -0.5) r) (polar c 0.0 r)) (ssadd (entlast) ss) ) (foreach c (vl-remove nil (even cl)) (command "_.arc" (polar c pi r) (polar c (* pi 0.5) r) (polar c 0.0 r)) (ssadd (entlast) ss) ) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (even cl)))) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (cdr (odd cl))))) (command "_.line" ip (polar (car cl) pi r) "") (ssadd (entlast) ss) ) ) ) (progn (setq lpl (car (entsel "\nPick right curve boundary..."))) (setq upl (car (entsel "\nPick left curve boundary..."))) (setq ip (getpoint "\nPick start point (\"left\" - Up-Down or \"bottom\" - Left-Right): ")) (initget 1 "Left Right") (setq dir (getkword "\nChoose start direction (Left / Right): ")) (if (eq dir "Left") (progn (command "_.offset" r lpl ip "") (setq lplo (entlast)) (command "_.offset" r upl ip "") (setq uplo (entlast)) (setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl)))) (setq c1 T c2 T k -3.0) (while (and c1 c2) (setq xl1 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (setq k (+ k 4.0)))) (polar (polar ip (* pi 0.5) (* r k)) 0.0 1.0))) (setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object uplo) acextendnone)) (vla-delete xl1) (setq xl2 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (+ k 2.0))) (polar (polar ip (* pi 0.5) (* r (+ k 2.0))) 0.0 1.0))) (setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object lplo) acextendnone)) (vla-delete xl2) (if c1 (setq cl (cons c1 cl))) (if (and c1 c2) (setq cl (cons c2 cl))) ) (setq cl (reverse cl)) (setq ss (ssadd)) (foreach c (vl-remove nil (odd cl)) (command "_.arc" (polar c (* pi -0.5) r) (polar c pi r) (polar c (* pi 0.5) r)) (ssadd (entlast) ss) ) (foreach c (vl-remove nil (even cl)) (command "_.arc" (polar c (* pi -0.5) r) (polar c 0.0 r) (polar c (* pi 0.5) r)) (ssadd (entlast) ss) ) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (even cl)))) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (cdr (odd cl))))) (command "_.line" ip (polar (car cl) (* pi -0.5) r) "") (ssadd (entlast) ss) ) (progn (command "_.offset" r lpl ip "") (setq lplo (entlast)) (command "_.offset" r upl ip "") (setq uplo (entlast)) (setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl)))) (setq c1 T c2 T k -3.0) (while (and c1 c2) (setq xl1 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (setq k (+ k 4.0)))) (polar (polar ip (* pi 0.5) (* r k)) 0.0 1.0))) (setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object lplo) acextendnone)) (vla-delete xl1) (setq xl2 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (+ k 2.0))) (polar (polar ip (* pi 0.5) (* r (+ k 2.0))) 0.0 1.0))) (setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object uplo) acextendnone)) (vla-delete xl2) (if c1 (setq cl (cons c1 cl))) (if (and c1 c2) (setq cl (cons c2 cl))) ) (setq cl (reverse cl)) (setq ss (ssadd)) (foreach c (vl-remove nil (odd cl)) (command "_.arc" (polar c (* pi -0.5) r) (polar c 0.0 r) (polar c (* pi 0.5) r)) (ssadd (entlast) ss) ) (foreach c (vl-remove nil (even cl)) (command "_.arc" (polar c (* pi -0.5) r) (polar c pi r) (polar c (* pi 0.5) r)) (ssadd (entlast) ss) ) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (even cl)))) (mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (cdr (odd cl))))) (command "_.line" ip (polar (car cl) (* pi -0.5) r) "") (ssadd (entlast) ss) ) ) ) ) (setvar 'peditaccept 1) (command "_.pedit" "m" ss "" "j" "" "") (entdel lplo) (entdel uplo) (setvar 'osmode osm) (setvar 'peditaccept pea) (command "_.ucs" "p") (princ) ) (defun c:sf-2c nil (c:snakefill-2curveboundaries)) (prompt "\n...Run with 'SF-2C'...") (princ) M.R.