Leaderboard

Like this ?? Here at downloads get a copy of Multi radio buttons.lsp it is for any users code.

Thanks Emmanuel, would have taken me ages to work that out! Try this version with 'BAP' added to replace breakatpoint command (defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa) ;;https://forums.autodesk.com/t5/autocad-forum/break-at-point/td-p/7553581 (defun BAP ( entity point /) ; (setq entity (entsel)) ; (setq point (getpoint)) (setq entity (list entity point)) ; recreate entsel.... Added this line (command "_.break" entity "_F" "_non" point "_non" point) ) (defun MakeLine ( con10 con11 / ) (entmakex (append (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine") (cons 10 con10) (cons 11 con11) )) ) ) ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-polyline-segment/td-p/1758253 (defun test ( / elst ename pt param preparam postparam) (setq elst (entsel "\nSelect pline segment: ")) (setq ename (car elst)) (setq pt (cadr elst)) (setq pt (vlax-curve-getClosestPointTo ename pt)) (print (setq param (vlax-curve-getParamAtPoint ename pt)) ) (print (setq preparam (fix param)) ) (print (setq postparam (1+ preparam)) ) (list (vlax-curve-getPointAtParam ename preparam) (vlax-curve-getPointAtParam ename postparam) elst ) ) (defun trimlinetopt ( MyLine TrimPt1 TrimPt2 / MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPT MyLineA MyLineB) (command "zoom" "Object" MyLine "") (command "zoom" "0.95x") (setq MyLineDef (entget MyLine)) (setq MyLineEndA (cdr (assoc 10 MyLineDef))) (if (= (cdr (assoc 0 MyLineDef)) "LINE") (setq MyLineEndB (cdr (assoc 11 MyLineDef))) (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef)))) ) ;;sort trimpts according to distance from end A (setq Pt1Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt1 "nea")) ) (setq Pt2Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt2 "nea")) ) (if ( > Pt1Dist Pt2Dist) (progn (setq TempPt TrimPt1) (setq TrimPt1 TrimPt2) (setq TrimPt2 TempPt) ) ;end progn ) ;end if ; (command "breakatpoint" MyLine TrimPt1) (princ MyLine) (BAP MyLine TrimPt1) (setq MyLineA (entlast)) ; (command "breakatpoint" MyLineA TrimPt2) (BAP MyLineA TrimPt2) (setq MyLineB (entlast)) (entdel MyLineA) (command "zoom" "Previous") (command "zoom" "Previous") MyLineA ) ;; add here something nice like "select lines or [option]" ;; Also add here something nice to remember value from last time (setq chdist (getreal "Enter Chamfer Distance: ")) (setq coords1 (test)) (setq coords2 (test)) (setq pline (car (last coords1))) (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1 (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2 ; (setq chdist 25) (command "chamfer" NL1 "Distance" chdist chdist NL2) (setq NL3 (entlast)) (setq NL3PtA (cdr (assoc 10 (entget NL3))) ) (setq NL3PtB (cdr (assoc 11 (entget NL3))) ) (command "move" NL1 "" NL3PtA NL3PtB ) (command "move" NL2 "" NL3PtB NL3PtA ) (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) ) (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int))) (entdel NL1) (entdel NL2) (setq NL1 (makeline ptsa NL3PtA) ); templine 3 (setq NL2 (makeline ptsa NL3PtB) ); templine 4 (entdel NL3) (trimlinetopt pline NL3PtA NL3PtB) (command "join" pline (entlast) NL1 NL2 "") )

breakatpoint is a new command in Autocad. So you need a recent Autocad version

Here is my attempt : (defun c:cha-lws-2-lins ( / *error* tttt wcs initvalueslst ucsf ti ss i lw lwx data lil s el ) (defun *error* ( m ) (if wcs (if ucsf (while (not (and (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6) (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6) (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6) ) ) (exe (list "_.UCS" "_P")) ) ) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (exe (list "_.UNDO" "_E"))) (if doc (vla-endundomark doc) ) ) ) (if initvalueslst (mapcar (function apply_cadr->car) initvalueslst) ) (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa)) (setq fun nil) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;; (defun vl-load nil (or cad (if vlax-get-acad-object (setq cad (vlax-get-acad-object)) (progn (vl-load-com) (setq cad (vlax-get-acad-object)) ) ) ) (or doc (setq doc (vla-get-activedocument cad))) (or alo (setq alo (vla-get-activelayout doc))) (or spc (setq spc (vla-get-block alo))) ) ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;; (or (and cad doc alo spc) (vl-load)) (defun exe ( tokenslist ) ( (lambda ( tokenslist / ctch ) (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t))) (progn (cmderr tokenslist) (catch_cont ctch) ) (progn (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) t ) ) ) tokenslist ) ) (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;; (if command-s (if flag (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))) flag ctch ) (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))) ctch ) ) (if flag (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist)))) flag ctch ) (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist))) ctch ) ) ) ) (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;; (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist))) ) (defun catch_cont ( ctch / gr ) (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...") (while (and (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0))))) (setq gr (grread)) (/= (car gr) 3) (not (equal gr (list 2 13))) ) ) (if (vl-catch-all-error-p ctch) ctch ) ) (defun apply_cadr->car ( sysvarvaluepair / ctch ) (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair)) (if (vl-catch-all-error-p ctch) (progn (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair)))) (catch_cont ctch) ) ) ) (defun ftoa ( n / m a s b ) (if (numberp n) (progn (setq m (fix ((if (< n 0) - +) n 1e-8))) (setq a (abs (- n m))) (setq m (itoa m)) (setq s "") (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0)))) (setq s (strcat s (itoa b))) (setq a (- (* a 10.0) b)) ) (if (= (type n) (quote int)) m (if (= s "") m (if (and (= m "0") (< n 0)) (strcat "-" m "." s) (strcat m "." s) ) ) ) ) ) ) (setq sysvarpreset (list (list (quote cmdecho) 0) (list (quote 3dosmode) 0) (list (quote osmode) 0) (list (quote unitmode) 0) (list (quote cmddia) 0) (list (quote ucsvp) 0) (list (quote ucsortho) 0) (list (quote projmode) 0) (list (quote orbitautotarget) 0) (list (quote insunits) 0) (list (quote hpseparate) 0) (list (quote hpgaptol) 0) (list (quote halogap) 0) (list (quote edgemode) 0) (list (quote pickdrag) 0) (list (quote qtextmode) 0) (list (quote dragsnap) 0) (list (quote angdir) 0) (list (quote aunits) 0) (list (quote limcheck) 0) (list (quote gridmode) 0) (list (quote nomutt) 0) (list (quote apbox) 0) (list (quote attdia) 0) (list (quote blipmode) 0) (list (quote copymode) 0) (list (quote circlerad) 0.0) (list (quote filletrad) 0.0) (list (quote filedia) 1) (list (quote autosnap) 1) (list (quote objectisolationmode) 1) (list (quote highlight) 1) (list (quote lispinit) 1) (list (quote layerpmode) 1) (list (quote fillmode) 1) (list (quote dragmodeinterrupt) 1) (list (quote dispsilh) 1) (list (quote fielddisplay) 1) (list (quote deletetool) 1) (list (quote delobj) 1) (list (quote dblclkedit) 1) (list (quote attreq) 1) (list (quote explmode) 1) (list (quote frameselection) 1) (list (quote ltgapselection) 1) (list (quote pickfirst) 1) (list (quote plinegen) 1) (list (quote plinetype) 1) (list (quote peditaccept) 1) (list (quote solidcheck) 1) (list (quote visretain) 1) (list (quote regenmode) 1) (list (quote celtscale) 1.0) (list (quote ltscale) 1.0) (list (quote osnapcoord) 2) (list (quote grips) 2) (list (quote dragmode) 2) (list (quote lunits) 2) (list (quote pickstyle) 3) (list (quote navvcubedisplay) 3) (list (quote pickauto) 3) (list (quote draworderctl) 3) (list (quote expert) 5) (list (quote auprec) 6) (list (quote luprec) 6) (list (quote pickbox) 6) (list (quote aperture) 6) (list (quote osoptions) 7) (list (quote dimzin) 8) (list (quote pdmode) 35) (list (quote pdsize) -1.5) (list (quote celweight) -1) (list (quote cecolor) "BYLAYER") (list (quote celtype) "ByLayer") (list (quote clayer) "0") ) ) (setq sysvarlst (mapcar (function car) sysvarpreset)) (setq sysvarvals (mapcar (function cadr) sysvarpreset)) (setq sysvarvals (vl-remove nil (mapcar (function (lambda ( x ) (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals)) )) sysvarlst ) ) ) (setq sysvarlst (vl-remove-if-not (function (lambda ( x ) (getvar x) )) sysvarlst ) ) (setq initvalueslst (apply (function mapcar) (cons (function list) (list sysvarlst (mapcar (function getvar) sysvarlst) ) ) ) ) (apply (function mapcar) (cons (function setvar) (list sysvarlst sysvarvals ) ) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (exe (list "_.UNDO" "_E"))) (if doc (vla-endundomark doc) ) ) ) (if (not (exe (list "_.UNDO" "_M"))) (if doc (vla-startundomark doc) ) ) (if wcs (if (= 0 (getvar (quote worlducs))) (progn (setq ucsf (list (getvar (quote ucsxdir)) (getvar (quote ucsydir)) (trans (list 0.0 0.0 1.0) 1 0 t) ) ) (exe (list "_.UCS" "_W")) ) ) ) wcs ) (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;; (initget 7) (setq chd (getdist "\nPick or specify chamfer distance : ")) (prompt "\nSelect LWPOLYLINE(s) that are in unlocked Layer(s) and placed in WCS...") (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE")))) (progn (setq ti (car (_vl-times))) (repeat (setq i (sslength ss)) (setq lw (ssname ss (setq i (1- i)))) (if (vl-every (function (lambda ( x ) (if (= (car x) 42) (/= (cdr x) 0.0)))) (setq lwx (entget lw))) (prompt "\nLWPOLYLINE has only arced segments - unable to perform task... Processing next LWPOLYLINE...") (progn (setq data (vl-remove-if-not (function (lambda ( x ) (or (= (car x) 10) (= (car x) 42)))) lwx)) (setq data (mapcar (function (lambda ( a b c d e f ) (if (and (= (cdr b) 0.0) (= (cdr d) 0.0) ) (list (cdr a) (cdr c) (cdr e) (angle (cdr c) (cdr a)) (angle (cdr c) (cdr e))) ) )) data (cdr data) (cddr data) (cdddr data) (cdr (cdddr data)) (cddr (cdddr data)) ) ) (setq data (vl-remove nil data)) (mapcar (function (lambda ( x / aa bb ip ) (exe (list "_.BREAK" (cadr x) (setq aa (polar (cadr x) (nth 3 x) chd)))) (if (and lw (not (vlax-erased-p lw)) (not (vl-position lw lil)) ) (setq lil (cons lw lil)) (setq lil (cons (entlast) lil)) ) (setq lil (cons (entlast) lil)) (exe (list "_.BREAK" (cadr x) (setq bb (polar (cadr x) (nth 4 x) chd)))) (exe (list "_.LINE" aa (setq ip (inters aa (polar aa (+ (* 0.5 pi) (nth 3 x)) 1.0) bb (polar bb (+ (* 0.5 pi) (nth 4 x)) 1.0) nil ) ) "" ) ) (setq lil (cons (entlast) lil)) (exe (list "_.LINE" bb ip "")) (setq lil (cons (entlast) lil)) )) data ) (setq s (ssadd)) (foreach li lil (ssadd li s) ) (setq el (entlast)) (exe (list "_.JOIN" s "")) (if (not (eq el (entlast))) (setq lwx (entget (setq lw (entlast)))) ) ) ) ) (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...") (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...") ) ) (*error* nil) ) HTH. Regards, M.R.

Custom routines are easy to get to do a task like this, its called Pay For it. I write custom routines and yes get paid. Did you contact the Youtube person ?

A quicky -VPOINT 0,-1,0 a quick zoom should show /= 0

You should know by now how to do a ssget say line,arc, circle,pline and depending on object, then look at each entity property checking Z value. For a big dwg may not be fast.

It can but only matches same values. even if you tell AutoCAD to draw a line from 50,50 it might be 50.00000000000001, 50.000000000000000000001 and thats not the same as 50,50. With equal you can give it a fuzz distance. This (equal 50 # 0.01) will return T for any number between 50.01 - 49.99

The easiest way to plot is to use the program as designed and use paperspace Have you tried importing a template with your pagesetups? Look into the command PSETUPIN. You could also use Lee's Steal program to pull views AND pagesetups from a template.

amazing!! thanks a lot for this this works perfectly on lines. much appreciated!!

See attached notch-lines-as-chamfer -do.LSP

Should be easy to modify mine to do lines and polylines... might need a thought if 1 is a line, 1 is a polyline - will do something later for this

Please test it for lines notch-lines.LSP

I wouldn't say a wast of time. and its only like what 2 or 3 months old? just imagine what it will be able to do in like a year or two. cool resource indeed but if using it to learn coding. keep in mind (just like here) it might not be giving you the right information. but the chat isn't going to correct itself. Were as if someone post here in error or if someone doesn't agree with the method its a good chance to get a follow up post.

That's no problem, people come to ask questions who are pretty good and are stuck, others come here whose boss tells them "get a LISP for that" and have to search what a LISP is... and everything in between. So assuming you can load and run a LISP program (or else see this: http://lee-mac.com/runlisp.html) save the code from alanjt to a file, call the file what you want with a '.l;sp' extension. In notepad for example in the save as use a file type *.* and call the file say DropDownBox.lsp. We're not going to modify what he suggested, it is a useful little function to use in the future (Which reminds me, I might come back to that later for something else for me) All that he wrote is a LISP, the way it works the LISP creates a temporary DCL file (on the fly) and refers to that, next time the LISP is run it will recreate that file (this is in the background, no need to worry about it), the benefit of this is that you don't need to worry about file locations for the DCL pop up.. it is just there. To run what he suggests use the line (sorry if you know all this.. start at the beginning) (AT:listselect mytitle mylabel myheight mywidth mymultiselect mylist) Each of these apart from mylist need to be a string. (You can have a list, a string or an integer, a string being text ( 'Hello World'), an integer is a number ('123') and a list is, well, a list ("Hello World" "123"). You might note here that the strings have quotes around them and the number 123 is a string You can also use variables in the command above. You might go for something like this then: (AT:listselect "Some Lists" "Select Text" "7" "25" "false" mylist) all strings. Except mylist. We can define that in a LISP. If we were using numbers it might be something like (AT:listselect "Some Lists" "Select Text" 7 25 "false" mylist), no quotes around the numbers and cause an error later on - for this code, others are different So put together you might run the code with something like: (defun c:DropDownList ( / mylist myresult) (setq mylist (list ; create a list "SP" "JC" (rtos (+ 5 7)) "Hello" "World" )) ; above list written on seperate lines for clarity, could be a single line with a space between list items) (setq myresult (AT:listselect "Some Lists" "Select Text" "7" "25" "false" mylist)) ; run another function, AT:listselect ;; Do your thing here (princ (nth 0 myresult)) ; (nth 0... or (car... to return a string of the first entity ;; (princ) ; exit silently - nothing shown in command line at exit ) ; end function Save that in your LSP file and see how it goes. Apologies if you know all of that