Leaderboard
Popular Content
Showing content with the highest reputation on 02/23/2023 in all areas
-
Morning @Steven P Thanks for your input and letting me know about MHUPP. All the best @mhupp Haha I agree, from my limited experience, it's been a little PITA! LISP has been a lot of trial and error for me. Ahh that works great! I think I had a bit of misunderstanding on the object properties, but I believe I have my head around it now- My understanding is the insertnth is doing the following. If the object is 'ByLayer, then the object just doesn't have the '62' property at all. So, if that is the case then it will insert the new user chosen color property into that 9th position rather than just the end of the list. I noticed that the behavior of the lisp with polylines does work but only changes the color after finishing/ending the lisp. This behavior is very similar to how my old original code worked with the colors of some types of objects only changing after finishing the tool. But ah, not so big a problem really- It still works! Cheers for your time Steven. Now I need to work some more on 'deploying' it to colleagues in a custom tool palette via OneDrive.. Let's see how it goes -AM2 points
-
Looks like Lee's formatting. YUP Change this: (append (car l) (reverse (cadr l))) To this: (reverse (append (car l) (reverse (cadr l))))2 points
-
Right a better answer for you.... keep what I said handy though (you or others reading this), it is a dead useful debugging too with or without the assoc part. MHUPP posted earlier - life is getting exciting for him - so forum time is limited while he does other good stuff, so apologies, you have the rest of us for now, Right... short answer... CAD is a PITA! In an entity description / association list some items are easy going, will go anywhere in the list and some like to be in the right place (In AutoCAD anyway, not sure about BricsCAD). Colour code is one that likes to be in the same place every time. If you do the (entget... ) thing above - without the assoc part on a coloured entity you'll see that '62' is often the 9th place in the list, just after '8' the layer code. If it isn't there then the entity is coloured 'bylayer' - but you just told me that part above. So is that enough for you to work it out... if it is stop reading.... This is what I did to test I was giving a half decent answer. Using Lee Mac as a reference, 'Insert Nth' - a great little code Something not quite right when it did a polyline - need an entupd. (defun C:ColorOffsetV3TEST13 (/ ansColor LastEnt en ent col) ;;Sub Routines ;; Insert Nth - Lee Mac ;; Inserts an item at the nth position in a list. ;; x - [any] Item to be inserted ;; n - [int] Zero-based index at which to insert item ;; l - [lst] List in which item is to be inserted (defun LM:insertnth ( x n l ) (cond ( (null l) nil) ( (< 0 n) (cons (car l) (LM:insertnth x (1- n) (cdr l)))) ( (cons x l)) ) ) ;; End Sub Routines (if (eq (setq ansColor (car (acad_truecolordlg 30))) nil) ;acad_colordlg for just the 256 types (setq ansColor '(62 . 250)) ) (setq LastEnt (entlast)) (command "OFFSET") (while (< 0 (getvar 'CMDACTIVE)) (if (setq en (entnext LastEnt)) (while en (setq ent (entget en)) (setq ent (vl-remove (assoc 420 ent) ent)) ; remove DXF Group Code 420 property if it exists (if (eq (setq col (assoc 62 ent)) nil) (entmod (LM:insertnth ansColor 9 ent)) ;; insert eg. (62 . 250) in 9th position in the entity ; (entmod (append ent ansColor)) ;; remove this - puts (62 . 250) at the end of the list.. no good (entmod (subst ansColor col ent)) ;; entity has a colour, replace that ) ; end if (setq en (entnext en)) ) ; end while ) ; end if (command pause) ) ; end while (princ) )2 points
-
Here is a AutoLISP vanilla example for you to start with and the text strings would be in a list and should be printed to command line if tag strings matched. (defun c:Test (/ sel ent get lst ) (and (princ "\nSelect attributed block to replace retrieve values : ") (or (setq sel (ssget "_+.:S" '((0 . "INSERT") (66 . 1)))) (alert "Invalid object or nothing selected! Try again.") ) (setq ent (ssname sel 0)) (while (not (eq (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND")) (and (wcmatch (strcase (cdr (assoc 2 get))) "PIPE_DIAM,PIPE_LENGTH") (setq lst (cons (cdr (assoc 1 get)) lst)) ) ) (princ lst) ) (princ) )2 points
-
Get & Setproperty are not supported in Bricscad V20 not sure about latest version. So for me use what I posted not everyone has Autocad. Bricscad, ZWcad, Intellicad, Drafsight to mention a few no idea which support Get & Set.1 point
-
If you want a more fixed range of color look at my Multi Radio Buttons.lsp, you can change ans to anscolor, you can add "Other" as an option which then calls the (acad_truecolordlg 30) press "cancel" can be added so sets color to black.Multi radio buttons.lsp1 point
-
1 point
-
Everyone has been very generous and I'm very thankful for that. You all are a great group of people! But @mhupp, you get the trophy! Thank you!!!1 point
-
Shout out to @ronjonp for showing me getpropertyvaule (setq ent (car (entsel "Pick obj")))) (setq pdia (getpropertyvalue ent "PIPE_DIAM")) (setq plen (getpropertyvalue ent "PIPE_LENGTH")) and if you want to update another block with attributes use setpropertyvalue1 point
-
You need get segment of pline, and a check of direction CW or CCW. ; Pline segment with angle and length (defun c:plseg() (setq plent (entsel "\nSelect Pline ")) (setvar "osmode" 0) (setq pick (cadr plent) plObj (vlax-ename->vla-object (car plent)) pick2 (vlax-curve-getclosestpointto plobj pick) param (vlax-curve-getparamatpoint plObj pick2) segment (fix param) co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))) (setq pt1 (nth segment co-ord)) (setq pt2 (nth (+ segment 1) co-ord)) (if (= pt2 nil)(setq pt2 (nth 0 co-ord))) (setq len (distance pt1 pt2)) (setq ang (angle pt1 pt2)) (alert (strcat "angle is " (rtos (/ (* ang 180.0) pi) 2 2) " Length is " (rtos len 2 3))) ) CW or CCW ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (progn (command "reverse" ent "") ; for Bricscad use pedit R (setq y (+ y 1)) ) ) ) (defun c:CWCCW ( / *error* x ent oldsnap doc ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq y 0) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (prompt (strcat "\nSelect Plines to check")) (if (setq ss (ssget '((0 . "*POLYLINE")))) (progn (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (AH:chkcwccw ent) ) ) ) (vla-endundomark doc) (alert (strcat (rtos y 2 0) " Plines reversed")) (setvar 'osmode oldsnap) (princ) ) (vl-load-com) (prompt "\nType CWCCW to set plines to CCW") (c:CWCCW)1 point
-
Interesting given it costs to use so if any of us say more experienced get asked here to fix code does that mean we will get paid also ?1 point
-
Excellent, you are most welcome Feel free to ask if you stuck with any part of the codes.1 point
-
These might help:' http://www.lee-mac.com/attributefunctions.html1 point
-
Updated the code a bit. if you where to offset multiple or both sides only one entity would change color. among other things. ;;----------------------------------------------------------------------------;; ;; Choose Color and offset (defun C:ColorOffsetV31 (/ ansColor LastEnt en) (if (eq (setq ansColor (car (acad_truecolordlg 30))) nil) ;acad_colordlg for just the 256 types (setq ansColor '(62 . 250)) ) (setq LastEnt (entlast)) (command "OFFSET") (while (< 0 (getvar 'CMDACTIVE)) (if (setq en (entnext LastEnt)) (while en (if (eq (setq col (assoc 62 (setq ent (entget en)))) nil) (entmod (append ent ansColor)) (entmod (subst ansColor col ent)) ) (setq en (entnext en)) ) ) (command pause) ) (princ) )1 point
-
why i try and stick with shorter command names or have a shortcut like (defun C:ColorOffsetV31 ... ) (defun C:COV31 () (C:ColorOffsetV31)) ;only calls longer code ---edit you might also like this option for picking a color. (if (eq (setq ansColor (acad_truecolordlg 30)) nil) ;acad_colordlg for just the 256 types (setq ansColor 250)) )1 point
-
@AM-AP Look: (defun C:ColorOffsetV31 vs. ^C^CColorOffsetV0311 point
-
1 point
-
1 point