Leaderboard

@ronjonp and @mhupp So as a alternative I wrote a piece of code that fills the xrecord length to 2047 characters and then creates a new xrecord and does the same until all the data is added. It was a wildly stupid way of handling it! In this use case xdata works so much better!

@ronjonp Thank you very much, that worked like a charm! In fact it makes things alot easier for me!

Was able to find the zip files that wasn't corrupted. as these aren't my files ill keep them up for a short time. so you can download them

.... And if the selected polyline is off screen along with any of the targeted objects.

_WP will fail if there are too many points as well.

Hello all, there is another issue with polylines: - polylines with double vertices and -self-intersecting/crossing polylines will cause ssget "C/WP" to fail. BTW, you can check if the polyline has arc/bulges. If so, there are some routines around here that subsitute the args with a series of short line.segments. The more line-segments, the better the cnverson works. regards Wolfgang

I think this might have fixed the issue, thankyou

Aunits Angdir Angbase

; Object Align - 2022.05.04 exceed (vl-load-com) (defun c:OA ( / util mode answer p s sl index ename obj box lll url basept targetpt ahbuttstitle ahbuttslst1 ahbuttslst2 pickmode modetxt answerlist originobj originbox olll ourl oll our ) (LM:startundo (LM:acdoc)) (setvar "cmdecho" 0) (setq util (vla-get-utility (LM:acdoc))) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (princ) ) (defun AH:Butts (ahdef ahbuttstitle ahbuttslst1 ahbuttslst2 / fo fname x k but1 but2 ) (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHbutts : dialog {" fo) (write-line (strcat " label =" (chr 34) (vl-princ-to-string ahbuttstitle) (chr 34) " ;" )fo) (write-line " : row {" fo) (write-line " : boxed_radio_column {" fo) (write-line (strcat "key = " (chr 34) (nth 0 ahbuttslst1) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth 0 ahbuttslst1) (chr 34) ";") fo) (write-line (strcat " width = " (rtos (+ 5 15) 2 0) " ;") fo) ; increase 10 if label does not appear (setq x 1) (repeat (- (length ahbuttslst1) 1) (write-line " : radio_button {" fo) (write-line (strcat "key = " (chr 34) "Rba" (rtos x 2 0) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth x ahbuttslst1) (chr 34) ";") fo) (write-line " }" fo) (setq x (+ x 1)) ) (write-line "spacer_1 ;" fo) (write-line " }" fo) (write-line " : boxed_radio_column {" fo) (write-line (strcat "key = " (chr 34) (nth 0 ahbuttslst2) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth 0 ahbuttslst2) (chr 34) ";") fo) (write-line (strcat " width = " (rtos (+ 5 15) 2 0) " ;") fo) ; increase 10 if label does not appear (setq x 1) (repeat (- (length ahbuttslst2) 1) (write-line " : radio_button {" fo) (write-line (strcat "key = " (chr 34) "Rbb" (rtos x 2 0) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth x ahbuttslst2) (chr 34) ";") fo) (write-line " }" fo) (setq x (+ x 1)) ) (write-line "spacer_1 ;" fo) (write-line " }" fo) (write-line " }" fo) (write-line "spacer_1 ;" fo) (write-line " ok_only;" fo) (write-line " }" fo) (close fo) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "AHbutts" dcl_id) ) (exit) ) (setq but1 1) (setq but2 1) (setq x 1) (repeat (length ahbuttslst1) (setq k (strcat "Rba" (rtos x 2 0))) (action_tile k (strcat "(setq but1 " (rtos x 2 0) ")")) (if (= ahdef x) (set_tile k "1")) (setq x (+ x 1)) ) (setq x 1) (repeat (length ahbuttslst2) (setq k (strcat "Rbb" (rtos x 2 0) )) (action_tile k (strcat "(setq but2 " (rtos x 2 0) ")")) (if (= ahdef x) (set_tile k "1")) (setq x (+ x 1)) ) (set_tile "Rba1" "1") (set_tile "Rbb1" "1") (action_tile "accept" (strcat "(done_dialog)")) (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) (list (nth but1 ahbuttslst1) (nth but2 ahbuttslst2)) ) (setq ahbuttstitle "Object Align") (setq ahbuttslst1 (list "Align by" "Pick Point" "Select Object")) (setq ahbuttslst2 (list "Direction" "Left" "Right" "Up" "Down" "Horizontal Center" "Vertical Center")) (if (= ahdef nil)(setq ahdef 1)) (setq answerlist (AH:Butts ahdef ahbuttstitle ahbuttslst1 ahbuttslst2)) (setq pickmode (car answerlist)) (setq modetxt (cadr answerlist)) (cond ((= modetxt "Left") (setq mode "L") ) ((= modetxt "Right") (setq mode "R") ) ((= modetxt "Up") (setq mode "U") ) ((= modetxt "Down") (setq mode "D") ) ((= modetxt "Horizontal Center") (setq mode "HC") ) ((= modetxt "Vertical Center") (setq mode "VC") ) ) (cond ((= pickmode "Pick Point") (princ "\n Select the objects to align : ") (setq s (ssget ":L")) (setq sl (sslength s)) (setq p (getpoint "\n Pick reference point : ")) (setq p (trans p 1 0)) (cond ((or (= mode "L") (= mode "R") (= mode "HC")) (setq p (car p)) ) ((or (= mode "U") (= mode "D") (= mode "VC")) (setq p (cadr p)) ) );end of cond (setq index 0) (repeat sl (setq ename (ssname s index)) (setq obj (vlax-ename->vla-object ename)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (cond ((= mode "L") (setq basept lll) (setq targetpt (list p (cadr basept) (caddr basept))) ) ((= mode "R") (setq basept url) (setq targetpt (list p (cadr basept) (caddr basept))) ) ((= mode "HC") (setq basept (list (/ (+ (car lll) (car url)) 2) (/ (+ (cadr lll) (cadr url)) 2) (/ (+ (caddr lll) (caddr url)) 2))) (setq targetpt (list p (cadr basept) (caddr basept))) ) ((= mode "U") (setq basept url) (setq targetpt (list (car basept) p (caddr basept))) ) ((= mode "D") (setq basept lll) (setq targetpt (list (car basept) p (caddr basept))) ) ((= mode "VC") (setq basept (list (/ (+ (car lll) (car url)) 2) (/ (+ (cadr lll) (cadr url)) 2) (/ (+ (caddr lll) (caddr url)) 2))) (setq targetpt (list (car basept) p (caddr basept))) ) );end of cond (vlax-invoke obj 'move basept targetpt ) (setq index (+ index 1)) ); end of repeat );end of cond case1 ((= pickmode "Select Object") (princ "\n Select the objects to align : ") (setq s (ssget ":L")) (setq sl (sslength s)) (princ "\n Select a reference object : ") (setq originobj (vlax-ename->vla-object (car (entsel)))) (setq originbox (vla-getboundingbox originobj 'oll 'our)) (setq olll (vlax-safearray->list oll)) (setq ourl (vlax-safearray->list our)) (cond ((= mode "L") (setq p (car olll)) ) ((= mode "R") (setq p (car ourl)) ) ((= mode "HC") (setq p (/ (+ (car olll) (car ourl)) 2)) ) ((= mode "U") (setq p (cadr ourl)) ) ((= mode "D") (setq p (cadr olll)) ) ((= mode "VC") (setq p (/ (+ (cadr olll) (cadr ourl)) 2)) ) );end of cond (setq index 0) (repeat sl (setq ename (ssname s index)) (setq obj (vlax-ename->vla-object ename)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (cond ((= mode "L") (setq basept lll) (setq targetpt (list p (cadr basept) (caddr basept))) ) ((= mode "R") (setq basept url) (setq targetpt (list p (cadr basept) (caddr basept))) ) ((= mode "HC") (setq basept (list (/ (+ (car lll) (car url)) 2) (/ (+ (cadr lll) (cadr url)) 2) (/ (+ (caddr lll) (caddr url)) 2))) (setq targetpt (list p (cadr basept) (caddr basept))) ) ((= mode "U") (setq basept url) (setq targetpt (list (car basept) p (caddr basept))) ) ((= mode "D") (setq basept lll) (setq targetpt (list (car basept) p (caddr basept))) ) ((= mode "VC") (setq basept (list (/ (+ (car lll) (car url)) 2) (/ (+ (cadr lll) (cadr url)) 2) (/ (+ (caddr lll) (caddr url)) 2))) (setq targetpt (list (car basept) p (caddr basept))) ) );end of cond (vlax-invoke obj 'move basept targetpt) (setq index (+ index 1)) );end of repeat );end of cond case2 );end of cond (setvar "cmdecho" 1) (LM:endundo (LM:acdoc)) (princ) );end of defun ;; 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) ) ;; 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) ) ) today, I practiced DCL. Most of this code is by BIGAL's Radio Button code. Thanks to him. after disassembling it like this, I think I know how to make dcl a little bit. and then create a bounding box and move it. aligns the selected objects like MS Office's Align function. I can't figure out why CAD's default align command is like 'piping join'. I think there must be a reason... command : OA (Object Align) - select the objects before or after run this - support UCS not only WCS (maybe..) If there are other good Lisp that do this, please let me know. It helps me with my studies.

Glad to see the 2 column radio buttons was useful. You dont need the dcl code in your code you can just have it as a lisp and use (if (not AH:Butts)(Load "Multi radio 2col.lsp")) you just have to have the lisp in a support directory or use full path in the (load "C:\\mylisp files\\Multi radio buttons 2col.lsp") I need to add a Cancel button. Maybe version 3 which will be multi columns, 1 to how ever many.

Please note the limits of (ssget "WP" pointlist) with polylines that have arcs. https://www.cadtutor.net/forum/topic/73104-polyline-coordinates/?do=findComment&comment=581425

Add 90° aka π/2 when calculating i in the 4th line. -Edit- had to keep the angle within 360 so it checks if the (_foo e) angle is less then 270 to add 90 or it will subtract 90. Horizontal lines would make a = 0 and would error with when dividing by 0 or does in Bricscad. added back in (+ pi a) and (- pi a) very neat code. going to have to remember the _foo mini function for the future. (defun c:foo (/ _foo e i s) (defun _foo (e) (abs (angle (vlax-curve-getstartpoint e) (vlax-curve-getendpoint e)))) (if (and (setq e (car (entsel "\nSelect Line to for Perpendicular Reference: "))) (if (< (setq i (_foo e)) (/ (* 3 pi) 2)) (setq i (+ i (/ pi 2))) (setq i (- i (/ pi 2))) ) (setq s (ssget "_X" '((-4 . "<OR") (0 . "line") (-4 . "<AND") (0 . "*polyline") (90 . 2) (-4 . "AND>") (-4 . "OR>") ) ) ) ) (progn (foreach pl (mapcar 'cadr (ssnamex s)) (if (or (equal (setq a (_foo pl)) i 1e-3) (equal (abs (- pi a)) i 1e-3) (equal (abs (+ pi a)) i 1e-3)) (progn) (ssdel pl s) ) ) (sssetfirst nil s) ) ) (prompt (strcat "\n" (rtos (sslength s) 2 0) " Lines found")) (princ) )

Thanks for sharing this lisp, i was thinking in doing something similar but much more simpler, I'll study it and use it. Thanks again.