Leaderboard

Consider the following code - (defun c:pk ( / zma zmi ) (if (and (setq zmi (getreal "\nSpecify elevation lower bound (inclusive): ")) (setq zma (getreal "\nSpecify elevation upper bound (inclusive): ")) ) (progn (if (< zma zmi) (mapcar 'set '(zmi zma) (list zma zmi))) (sssetfirst nil (ssget "_X" (list '(000 . "LWPOLYLINE") '(-04 . ">=") (cons 038 (- zmi 1e-3)) '(-04 . "<=") (cons 038 (+ zma 1e-3)) ) ) ) ) ) (princ) )

@Trap3d For your top example explode the region then join and remove the island. Your second scenario will need manual cleanup. In your third scenario I mentioned this shortcoming when I posted the code. Oversize your offset by X so they join, then explode, join and finally offset inward the difference.

@land My way to skin the fish. arcs-chords+arrow.dwg make-arrows-@-arcs.LSP

It seems to be caused by the arrow block. It does well with a Multileader and a closed arrow. In many instances, just the arrow fades. Might be a quirk and/or bug.

I had a LISP I was working on that when it errored the right-click wasn't working. A restart of AutoCAD fixed it, but then my ACADDOC resets my SysVars. Try a repair if a restart doesn't work. Did you check Autodesk Civil 3D Forum to see if it's a bug?

This for bulge of Lwpolyline or arc? (vl-load-com) (defun make_line (dxf / lst_dxf) (setq lst_dxf (list (cons 0 "LINE") (cons 100 "AcDbEntity") (assoc 67 dxf) (assoc 410 dxf) (cons 8 (getvar "CLAYER")) (cons 100 "AcDbLine") (cons 10 pt_mid) (cons 11 pt_mid-vtx) (assoc 210 dxf) ) ) (foreach n '(6 39 48 62 370 420) (if (assoc n dxf) (setq lst_dxf (append lst_dxf (list (assoc n dxf)))) ) ) (entmake lst_dxf) ) (defun c:arrow ( / ss n ename obj dxf_ent dxf_210 pr seg_bulge pt_first pt_snd pt_mid-vtx pt_mid) (princ "\nSelect polylines or arcs ") (while (null (setq ss (ssget '((0 . "LWPOLYLINE,ARC")))))) (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ename) dxf_ent (entget ename) dxf_210 (cdr (assoc 210 dxf_ent)) pr -1 ) (cond ((eq (cdr (assoc 0 dxf_ent)) "ARC") (setq pt_mid-vtx (vlax-curve-getPointAtParam obj (* (+ (vlax-curve-getStartParam obj) (vlax-curve-getEndParam obj)) 0.5)) pt_mid (mapcar '* (mapcar '+ (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) '(0.5 0.5 0.5)) ) (make_line dxf_ent) ) (T (repeat (fix (vlax-curve-getEndParam ename)) (setq seg_bulge (vla-GetBulge obj (setq pr (1+ pr)))) (cond ((not (zerop seg_bulge)) (setq pt_first (trans (vlax-curve-GetPointAtParam ename pr) 0 dxf_210) pt_snd (trans (vlax-curve-GetPointAtParam ename (1+ pr)) 0 dxf_210) pt_mid-vtx (trans (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) 0 dxf_210) pt_mid (mapcar '* (mapcar '+ pt_first pt_snd) '(0.5 0.5 0.5)) ) (make_line dxf_ent) ) ) ) ) ) ) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (prin1) )

Please post the .dwg.

Upload your drawing to take a close look.

I don't know but this is working pretty well on my end, maybe is the old webpage code that is causing you problems, here is the code again ;; Near Points - Lee Mac ;; Creates a selection set of all points separated by a specified distance or less. ;; Utilises a divide & conquer algorithm. (defun c:nearpoints ( / a b e f i r s x y ) (if (setq s (ssget '((0 . "POINT")))) (progn (initget 6) ;;; No 0 or negative allowed (setq f (cond ((getdist "\nSpecify Tolerance <1.0>: ")) (1.0))) (setq a (vl-sort (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i))) a (cons (cons (cdr (assoc 10 (entget e))) e) a) ) ) '(lambda ( a b ) (<= (caar a) (caar b))) ) ) (setq r (ssadd)) (while (setq x (car a)) (setq a (cdr a) b a ) (while (and (setq y (car b)) (<= (- (caar y) (caar x)) f)) (if (<= (distance (car x) (car y)) f) (progn (ssadd (cdr x) r) (ssadd (cdr y) r) ) ) (setq b (cdr b)) ) ) (sssetfirst nil r) ) ) (princ) )

Hi, I have this in my library... It select blocks by visibility states... So, you have to select blocks and input visibility state you wish through dialog box and new selection will be created... Then you can do (if (ssget "_I") (sslength (ssget "_I")) 0) to count blocks... (defun selvis ( / ent i props ss your_visibility ) ; <--- Returns the selection set with the desired visibility states (defun getvisstates ( ss / unique LM:getvisibilitystatesnames i blk lst ) (defun unique ( lst ) (if lst (cons (car lst) (unique (vl-remove-if '(lambda ( x ) (or (= (strcase x) (car lst)) (= x (car lst)))) (cdr lst))))) ) ;; Get Visibility States Names - Lee Mac ;; Returns the names of the Visibility States of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Names of Visibility States, else nil (defun LM:getvisibilitystatesnames ( blk / vis ) (if (and (vlax-property-available-p blk 'effectivename) (setq blk (vla-item (vla-get-blocks (vla-get-document blk)) (vla-get-effectivename blk) ) ) ;(= :vlax-true (vla-get-isdynamicblock blk)) to account for NUS dynamic blocks (= :vlax-true (vla-get-hasextensiondictionary blk)) (setq vis (vl-some '(lambda (pair) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK" ) ) ) ) ;(cdr (assoc 301 (entget vis))) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 303)) (entget vis))) ) ) (if ss (repeat (setq i (sslength ss)) (setq blk (ssname ss (setq i (1- i)))) (if (= (vla-get-isdynamicblock (vlax-ename->vla-object blk)) :vlax-true) (setq lst (append lst (LM:getvisibilitystatesnames (vlax-ename->vla-object blk)))) ) ) ) (unique (reverse lst)) ) (defun AT:ListSelect ( title label height width multi lst / fn fo d item f ) ;; List Select Dialog (Temp DCL list box selection, based on provided list) ;; title - list box title ;; label - label for list box ;; height - height of box ;; width - width of box ;; multi - selection method ["true": multiple, "false": single] ;; lst - list of strings to place in list box ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite) (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w")) (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;") (strcat ": list_box { label = \"" label "\";" "key = \"lst\";") (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";") (strcat "width = " (vl-princ-to-string width) ";") (strcat "multiple_select = " multi "; } spacer; ok_cancel; }") ) (write-line x fo) ) (close fo) (new_dialog "list_select" (setq d (load_dialog fn))) (start_list "lst") (mapcar (function add_list) lst) (end_list) ;;;(setq item (set_tile "lst" "0")) (action_tile "lst" "(setq item $value)") (setq f (start_dialog)) (unload_dialog d) (vl-file-delete fn) (if (= f 1) (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" item ")"))) ) ) (setq ss (ssget '((0 . "INSERT"))) your_visibility (mapcar 'strcase (AT:ListSelect "CHOOSE VISIBILITY STATES YOU WANT TO HIGHLIGHT" "VISIBILITY STATES" 40 30 "true" (getvisstates ss)) ) ) (repeat (setq i (sslength ss)) (if (or (eq (vla-get-IsDynamicBlock (vlax-ename->vla-object (setq ent (ssname ss (setq i (1- i)))) ) ) :vlax-false ) (and (setq props (vl-remove-if-not '(lambda ( x ) (wcmatch (strcase (vla-get-PropertyName x)) "VISIBILITY*" ) ) (vlax-invoke (vlax-ename->vla-object ent) 'GetDynamicBlockProperties ) ) ) (vl-some '(lambda ( x ) (if (null (vl-position (strcase (vlax-get x 'Value)) your_visibility ) ) (ssdel ent ss) ) ) props ) ) ) (ssdel ent ss) ) ) ss ) (defun c:selvis ( / ss ) (if (null (vl-catch-all-error-p (setq ss (vl-catch-all-apply 'selvis)) ) ) (sssetfirst nil ss) ) (princ) ) HTH. M.R.

;; RETABLE - 2022.03.04 exceed ;; https://www.cadtutor.net/forum/topic/74577-redraw-table-line-for-old-table-texts-and-lines/ (defun C:RETABLE ( / *error* x_tol text_size_sample text_ss text_size y_tol text_ss_length text_ss_index text_data_list text_ent text_ent_name text_box text_box_min_x text_box_min_y text_box_max_x text_box_max_y text_data tdll tdllindex memory_min_x memory_min_y memory_max_x memory_max_y now_min_y now_max_y mid_y now_min_x now_max_x mid_y_stack mysl mysindex memory_mys filtered_mys now_mys gap_mys pt1 pt2 first_y last_y first_x mid_x_stack mid_x mxsl mxsindex memory_mxs filtered_mxs now_mxs gap_mxs mid_x_stack pt3 pt4 last_x ) (LM:startundo (LM:acdoc)) (setvar "cmdecho" 0) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (setq x_tol 0) (setq y_tol 0) (setq text_size 0) (setq text_ss_length 0) (princ "\n RETABLE - Select Texts to Remake Table Line") (setq text_ss (ssget ":L" '((0 . "*TEXT")) ) ) (initget 4) (setq x_tol (getreal "\n Input X-axis tolerance < 0 >")) (if (= x_tol nil) (setq x_tol 0)) (setq text_size_sample (entget (ssname text_ss 0))) (setq text_size (cdr (assoc 40 text_size_sample))) ;(princ "\n text_size - ") ;(princ text_size) (initget 4) (setq y_tol (getreal (strcat "\n Input Y-axis tolerance < " (vl-princ-to-string text_size) " >"))) (if (= y_tol nil) (setq y_tol text_size)) (setq text_ss_length (sslength text_ss)) (setq text_ss_index 0) (setq text_data_list nil) (setq text_ent nil) (repeat text_ss_length (setq text_ent (entget (ssname text_ss text_ss_index))) (setq text_ent_name (cdr (assoc -1 text_ent))) (setq text_box (text-box-off text_ent 0)) (setq text_box_min_x (car (car text_box))) (setq text_box_min_y (cadr (car text_box))) (setq text_box_max_x (car (caddr text_box))) (setq text_box_max_y (cadr (caddr text_box))) (setq text_data (list text_box_min_x text_box_min_y text_box_max_x text_box_max_y)) ;text_ent_name)) (setq text_data_list (cons text_data text_data_list)) (setq text_ss_index (+ text_ss_index 1)) ) ;(princ text_data_list) (setq text_data_list (vl-sort text_data_list (function (lambda (x1 x2)(< (cadr x1) (cadr x2))) ) ) ) ;(princ "\n sorted by min_y list =") ;(princ text_data_list) (setq tdll (length text_data_list)) (setq tdlindex 0) (setq memory_min_x (car (nth 0 text_data_list))) (setq memory_min_y (cadr (nth 0 text_data_list))) (setq memory_max_x (caddr (nth 0 text_data_list))) (setq memory_max_y (cadddr (nth 0 text_data_list))) (setq mid_y_stack nil) (repeat (- tdll 1) (setq now_min_y (cadr (nth tdlindex text_data_list))) (setq now_max_y (cadddr (nth tdlindex text_data_list))) (if (> now_min_y memory_max_y) (progn (setq mid_y (/ (+ now_min_y memory_max_y) 2)) (setq memory_max_y now_max_y) (setq memory_min_y now_min_y) ) (progn (setq memory_max_y now_max_y) ) ) ;(princ "\n mid_y : ") ;(princ mid_y) (setq mid_y_stack (cons mid_y mid_y_stack)) (setq tdlindex (+ tdlindex 1)) ) (setq tdlindex 0) (repeat tdll (setq now_min_x (car (nth tdlindex text_data_list))) (setq now_max_x (caddr (nth tdlindex text_data_list))) (if (< now_min_x memory_min_x) (progn (setq memory_min_x now_min_x) ) ) (if (> now_max_x memory_max_x) (progn (setq memory_max_x now_max_x) ) ) (setq tdlindex (+ tdlindex 1)) ) (setq mid_y_stack (LM:Unique mid_y_stack)) (setq mid_y_stack (cdr (vl-sort mid_y_stack '<))) ;(princ "\n mid_y_stack : ") ;(princ mid_y_stack) (setq mysl (length mid_y_stack)) (setq mysindex 1) (setq memory_mys (car mid_y_stack)) (setq filtered_mys (list (car mid_y_stack))) (repeat (- mysl 1) (setq now_mys (nth mysindex mid_y_stack)) (setq gap_mys (- now_mys memory_mys)) ;(princ "\n gap_mys - ") ;(princ gap_mys) (if (> gap_mys y_tol) (setq filtered_mys (cons now_mys filtered_mys)) ) (setq memory_mys now_mys) (setq mysindex (+ mysindex 1)) ) (setq mid_y_stack (reverse filtered_mys)) ;(princ "\n filtered mid_y_stack - ") ;(princ mid_y_stack) ;(princ "\n min_x : ") ;(princ memory_min_x) ;(princ "\n max_x : ") ;(princ memory_max_x) (setq last_x (+ memory_max_x (atoi (rtos (/ text_size 2) 2 0))) ) (setq text_data_list (vl-sort text_data_list (function (lambda (x1 x2)(< (car x1) (car x2))) ) ) ) (setq memory_min_x (car (nth 0 text_data_list))) (setq first_x (- memory_min_x (atoi (rtos (/ text_size 2) 2 0)))) (setq mysl (length mid_y_stack)) (setq mysindex 0) (repeat mysl (setq pt1 (list first_x (nth mysindex mid_y_stack))) (setq pt2 (list last_x (nth mysindex mid_y_stack))) ;(princ "\n pt1 : ") ;(princ pt1) ;(princ "\n pt2 : ") ;(princ pt2) (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) ) ) (setq mysindex (+ mysindex 1)) ) ;draw outline (setq first_y 0) (setq last_y 0) (setq first_y (+ (nth (- mysl 1) mid_y_stack) (- (nth (- mysl 1) mid_y_stack) (nth (- mysl 2) mid_y_stack)) ) ) (setq last_y (- (car mid_y_stack) (- (cadr mid_y_stack) (car mid_y_stack)) ) ) ;(princ "\n first_y : ") ;(princ first_y) ;(princ "\n last_y : ") ;(princ last_y) (entmake (list '(0 . "LINE") (cons 10 (list first_x first_y)) (cons 11 (list last_x first_y)) ) ) (entmake (list '(0 . "LINE") (cons 10 (list first_x last_y)) (cons 11 (list last_x last_y)) ) ) ;draw x line (setq tdlindex 0) (setq memory_max_x (caddr (nth 0 text_data_list))) (setq mid_x_stack '()) (repeat (- tdll 1) (setq now_min_x (car (nth tdlindex text_data_list))) (setq now_max_x (caddr (nth tdlindex text_data_list))) (if (> now_min_x memory_max_x) (progn (setq mid_x (/ (+ now_min_x memory_max_x) 2)) (setq memory_max_x now_max_x) (setq memory_min_x now_min_x) ) (progn (setq memory_max_x now_max_x) ) ) ;(princ "\n mid_x : ") ;(princ mid_x) (setq mid_x_stack (cons mid_x mid_x_stack)) (setq tdlindex (+ tdlindex 1)) ) (setq mid_x_stack (LM:Unique mid_x_stack)) (setq mid_x_stack (cdr (vl-sort mid_x_stack '<))) ;(princ "\n mid_x_stack - ") ;(princ mid_x_stack) (setq mxsl (length mid_x_stack)) (setq mxsindex 1) (setq memory_mxs (car mid_x_stack)) (setq filtered_mxs (list (car mid_x_stack))) (repeat (- mxsl 1) (setq now_mxs (nth mxsindex mid_x_stack)) (setq gap_mxs (- now_mxs memory_mxs)) ;(princ "\n gap_mxs - ") ;(princ gap_mxs) (if (> gap_mxs x_tol) (setq filtered_mxs (cons now_mxs filtered_mxs)) ) (setq memory_mxs now_mxs) (setq mxsindex (+ mxsindex 1)) ) (setq mid_x_stack (reverse filtered_mxs)) ;(princ "\n filtered mid_x_stack - ") ;(princ mid_x_stack) (setq mxsl (length mid_x_stack)) (setq mxsindex 0) (repeat mxsl (setq pt3 (list (nth mxsindex mid_x_stack) last_y)) (setq pt4 (list (nth mxsindex mid_x_stack) first_y)) ;(princ "\n pt3 : ") ;(princ pt3) ;(princ "\n pt4 : ") ;(princ pt4) (entmake (list '(0 . "LINE") (cons 10 pt3) (cons 11 pt4) ) ) (setq mxsindex (+ mxsindex 1)) ) (entmake (list '(0 . "LINE") (cons 10 (list first_x first_y )) (cons 11 (list first_x last_y)) ) ) (entmake (list '(0 . "LINE") (cons 10 (list last_x first_y)) (cons 11 (list last_x last_y)) ) ) (princ "\n RETABLE - done.") (LM:endundo (LM:acdoc)) (setvar "cmdecho" 1) (princ) ) ;; Text Box - gile / Lee Mac ;; Returns an OCS point list describing a rectangular frame surrounding ;; the supplied text or mtext entity with optional offset ;; enx - [lst] Text or MText DXF data list ;; off - [rea] offset (may be zero) (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid ) (cond ( (= "TEXT" (cdr (assoc 00 enx))) (setq bpt (cdr (assoc 10 enx)) rot (cdr (assoc 50 enx)) lst (textbox enx) lst (list (list (- (caar lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar lst) off) (+ (cadadr lst) off)) ) ) ) ( (= "MTEXT" (cdr (assoc 00 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 10 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs)) wid (cdr (assoc 42 enx)) hgt (cdr (assoc 43 enx)) jus (cdr (assoc 71 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list (list (- (car org) off) (- (cadr org) off)) (list (+ (car org) wid off) (- (cadr org) off)) (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off) (+ (cadr org) hgt off)) ) ) ) ) (if lst ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) redraw lines for texts, which are arranged like old-style tables with texts and lines. this lisp can use when they are lost lines, or a part of the line is in the xref, or lost xref files or etc.... there are many Lisp, that turns old tables into tables but generally for that lisp need these lines or that ignores blank cells by outputting only the position of the text. this is not complete routine. it may not calculate the left and right widths properly but it can enough to use it for conversion lisp. i think command : RETABLE (minimum table size = 2 column x 3 row) I used a text box to resolve the different alignment points. and there may be texts with slightly different x values, slightly different y values, or overlapping texts in real work, so I put a tolerance value that ignores them. x tol - x length to ignore (default: 0) y tol - y length to ignore (default: font size) - different access. I have been trying to compare the textbox and basepoint to measure the max number of rows and columns. and calculate which column is close to the empty cells. but I still have a long way to go.

Isolate layer, select everything, then open your properties box and select MText or Text from the drop down. You can then change any of properties listed and it will onloy affect the text.