Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 06/22/2022 in all areas

  1. Its easy enough to do but are we talking about one layer or multiple layers? if its multiple layers what layer goes where? Sorry you said object I was thinking blocks. ;;----------------------------------------------------------------------------;; ;; SWITCH LAYERS BETWEEN OBJECTS (defun C:SwapLayer (/ OA OB LA LB) (setq OA (car (entsel "\nSelect first object: ")) LA (cdr (assoc 8 (setq OA (entget OA)))) OB (car (entsel "\nSelect second object: ")) LB (cdr (assoc 8 (setq OB (entget OB)))) ) (if (eq LA LB) (prompt "\nBoth Entities are on same layer") (progn (entmod (subst (cons 8 LB) (assoc 8 OA) OA)) (entmod (subst (cons 8 LA) (assoc 8 OB) OB)) ) ) (princ) )
    1 point
  2. This is something I have wanted to do for a while, felt inspired to do it this evening and is stage 2of the question I think incrementing the area references (A ->B etc). Written to replace what I was using though some notes still in there for things to finish off at another date. The Command (xyzuprev Txt inc) where Txt is the text string to increase by the number, 'inc'. Will increase numbers (including leading zeros), and letter or combinations of them Will fail if 'inc' is more than 9 or 26 (for numbers / letters) - just me being lazy to not correct that yet, but for this question that is good enough I added (setq AreaLabel (getstring "\nEnter First Area Label: ")) ;;as the 2nd line and (setq inc 1) (setq AreaLabel (xyzuprev AreaLabel inc)) ;;as the last 2 lines in the while loop to the code above to get it to work (defun xyzuprev (Txt inc / TxtCount SplitTxt IncTextList ) ;; 0: Ascii 48 ;; 9: Ascii 57 ;; A: ascii 65 ;; Z: Ascii 90 ;; a: ascii 97 ;; z: Ascii 122 ;;; Sub Functions ;;;; ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-replace-an-item/td-p/10768078 (defun plusp (num) (cond ((numberp num) (>= num 0.0)))) (defun set_nth (lst n value) ;Sets n-th element of a list to new value (set_nth '(1 2 3 4) 2 5) -> (1 2 5 4) (cond ((and (plusp n) (<= n (length lst))) (cond ((zerop n) (cons value (cdr lst)) ) (t (cons (car lst) (set_nth (cdr lst) (1- n) value))) )))) (defun txt2list( Txt / SplitTxt acount) ;;seperate characters to list items (setq SplitTxt (list) ) (setq acount 0) (while (< acount (strlen Txt)) (setq SplitTxt (append SplitTxt (list(substr Txt (+ acount 1) 1)))) (setq acount (+ acount 1)) ) ;end while SplitTxt ) (defun list2txt( SplitTxt / Txt acount) ;;Join list items to a text string (setq acount 0) (setq Txt "") (while (< acount (length SplitTxt)) (setq Txt (strcat Txt (nth acount SplitTxt))) (setq acount (+ acount 1)) ) ;end while Txt ) (defun inclisttext ( Lst Pos Inc / nextinc ) ;increment a text character in a string (setq nextinc 0) ;; Add here error check if the list item is more than 1 character long (setq Units (+ (ascii (nth Pos Lst)) Inc)) ;; ASCII CODE ;; these should be conds really (if (and (< 57 Units)(> 65 Units)) (progn (setq Units (- Units 10)) (setq nextinc 1) )) (if (and (< 90 Units)(> 97 Units)) (progn (setq Units (- Units 26)) (setq nextinc 1) )) (if (< 122 Units) (progn (setq Units (- Units 26)) (setq nextinc 1) )) (list (set_nth Lst Pos (chr Units)) nextinc) ) ;;;; End Sub Functions ;;;;; ;; add here pause cmd echo ;; Add here start undo ;; Add here error check ;; Add here check if text is a date (if (numberp Txt)(rtos Txt)) ;; Make text a string (setq TxtCount 0) (while (< TxtCount (strlen Txt)) (setq SplitTxt (reverse (txt2list Txt))) (setq IncTextList (inclisttext SplitTxt TxtCount inc)) (setq Txt (list2Txt (reverse (nth 0 IncTextList))) ) (setq inc (nth 1 IncTextList)) (setq TxtCount (+ TxtCount 1)) ) (if (= 1 inc)(alert "Text Length exceeded")) ;; add her a check if Txt was a number, return it to being a number ;; finish LISP, CMD echo, error, undo etc. Txt )
    1 point
  3. 66 second to run the speed lisp? your pc might need an upgrade. This work computer was mid range when the bought it 8 years go. if you have windows hit Ctrl+Shift+Esc to bring up the task manager. CPU, Memory, and disk usage shouldn't be over 50% if you just have a drawing open.
    1 point
  4. There is nothing there that wouldn't take 1 or 2milliseconds to compute. my 2¢ their is something in the sub routines that is either not cleaning its variable data between commands. so if every time you type the command it takes longer and longer. because its looking at more and more data. Or its very slow when its looking at existing data. If every time you run the command after the first time its taking longer but ruffly the same amount of time no matter how many times you run the command. you would need to optimize your code. (defun c:speed (/ i n start stop) ;need to delcare local variables so they are cleared when lisp ends (setq start (getvar "millisecs")) (setq i 0) (setq n 10000000) (repeat n (if (= (1+ i) n) (progn (setq stop (getvar "millisecs")) (setq x (- stop start)) (alert (strcat "Arrive at: " (itoa n) "\nSpeed lisp finished in " (itoa x) " ms")) ) ) (setq i (1+ i)) ) (princ) ) 10,000,000 loops only takes 422 ms on my pc.
    1 point
  5. 1 point
  6. Like the others you really only need a csv file do you need Excel ? oldtext,newtext oldtext,newtext Get all the *text and just go through the list made from reading the csv, if match then change. The copy and paste part could be instead pick and write a csv file but with "oldtext," only then just open in notepad. Note "," 2nd lisp auto reads csv file.
    1 point
  7. Looking at this in parts, not sure how stuck you are with this you see, but be patient with me. So objective 1, getting the area and a slightly unusual method I think based on an answer to another question, using '-Hatch' and picking an internal point: Here you select a point enclosed by lines, polylines, circles, etc so long as the area is completely enclosed. Lines can be at different elevations I think. Exactly the same rules as if you were creating a hatch. You also need to see some of border for the area you want to calculate. (defun c:getarea ( / MyPt eo areA) (setq MyPt (getpoint "Select Internal Point")) (command "-hatch" MyPt "") (setq obj (vlax-ename->vla-object (entlast))) (setq area (vlax-get obj 'Area)) (entdel (entlast)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;The above gets the area (as variable area, I'm a simple man) and a point (MyPt, nearly as obvious, that's a complex as I want to be) ;;Use the variable area as you want, here it is writng that to the point you selected initially, MyPt (command "text" MyPt "" "" (strcat "Area = " (rtos area 2 2) " sq. units") "") ;;And here it is writing the area identifier, for example 'A' in this case (setq MyPt (mapcar '+ '(0 5 0) MyPt)) (command "text" MyPt "" "" "A" "") (princ) ) Used in a loop you could ask the user to enter or select the most recently used reference text (A, B, AA, AB, or whatever), increment that by 1, ask the user to select a point in the area and then loop to select a point in the next area saving or select the table cells and then loop as your preference might be. I would prefer to select all the areas, save their areas into a list and label them before going to the table to complete that. For the next stage, have you got an example table you would use that could be used to check out populating what you want and how?
    1 point
  8. Which is a great LISP though I am not sure if it would save much here if you are changing a single drawing, still got to copy and paste the first text and its replacement from the text file / spreadsheet. Great though for changing a batch of drawings
    1 point
  9. Take a look at Lee Mac's Batch Find & Replace Text lisp as a possible solution. I'm sure there's a lisp solution but attaching or adding a link to small before & after drawings so we'd know what you're trying to do. There's lots of lisp for adding prefixes and suffixes but right now we have no idea what you're looking for.
    1 point
  10. Sounds like you just need a bit of a hint and that will get you going? Find and replace text is menu driven in AutoCAD.... and so tricky to automate with a LISP, You could try this which works through the command line, and also with a LISP passing find and replace text strings to it. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883 I have used it with a couple of lists like this to replace many text strings at once: new_list is a list or text to add old_list is a list of text to replace. Noting of course that the nth items should correspond (setq lst_length (min (length new_lst) (length old_lst)) acount 0 );end_setq (while (< acount lst_length) (setq changes (+ (FindReplaceAll (nth acount old_lst) (nth acount new_lst)) changes)) (setq acount (+ 1 acount)) ); end while
    1 point
  11. ; Equation Graph by autolisp - 2022.06.20 exceed ; command list : yx1, yx2, yx3, yx4, yx5, yx6, y2x2 (circle) ; not a complete routine just for fun ; https://www.cadtutor.net/forum/topic/75463-equation-graph-by-autolisp/ ; If it's for your homework, it's not a good choice to use it. ; Use a program that draws accurate graphs. matlab, etc. Excel is also good. (defun c:yx1 ( / a b startx endx steps deltax ptlist pt mspace tmp myobj ylist ) (princ "\n y = Ax + B ") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq startx (getreal "\n Input Start X = ")) (setq endx (getreal "\n Input End X = ")) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (* a x) b)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ylist (vl-sort ylist '<)) (setq ymin (car ylist)) (setq ymax (last ylist)) (setq ptlist (reverse ptlist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis startx endx ymin ymax steps) (princ) ) (defun c:yx2 ( / a b c startx endx steps deltax ptlist pt mspace tmp myobj ylist ) (princ "\n y = Ax^2 + Bx + C") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq c (getreal "\n Input C = ")) (setq startx (getreal "\n Input Start X = ")) (setq endx (getreal "\n Input End X = ")) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (* a x x) (* b x) c)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ylist (vl-sort ylist '<)) (setq ymin (car ylist)) (setq ymax (last ylist)) (setq ptlist (reverse ptlist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis startx endx ymin ymax steps) (princ) ) (defun c:yx3 ( / a b c d startx endx steps deltax ptlist pt mspace tmp myobj ylist ) (princ "\n y = Ax^3 + Bx^2 + Cx + D") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq c (getreal "\n Input C = ")) (setq d (getreal "\n Input D = ")) (setq startx (getreal "\n Input Start X = ")) (setq endx (getreal "\n Input End X = ")) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (* a x x x) (* b x x) (* c x) d)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ylist (vl-sort ylist '<)) (setq ymin (car ylist)) (setq ymax (last ylist)) (setq ptlist (reverse ptlist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis startx endx ymin ymax steps) (princ) ) (defun c:yx4 ( / a b c d e startx endx steps deltax ptlist pt mspace tmp myobj ylist ) (princ "\n y = Ax^4 + Bx^3 + Cx^2 + Dx + E ") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq c (getreal "\n Input C = ")) (setq d (getreal "\n Input D = ")) (setq e (getreal "\n Input E = ")) (setq startx (getreal "\n Input Start X = ")) (setq endx (getreal "\n Input End X = ")) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (* a x x x x) (* b x x x) (* c x x) (* d x) e)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ylist (vl-sort ylist '<)) (setq ymin (car ylist)) (setq ymax (last ylist)) (setq ptlist (reverse ptlist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis startx endx ymin ymax steps) (princ) ) (defun c:yx5 ( / a b c d e f startx endx steps deltax ptlist pt mspace tmp myobj ylist ) (princ "\n y = Ax^5 + Bx^4 + Cx^3 + Dx^2 + Ex + F ") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq c (getreal "\n Input C = ")) (setq d (getreal "\n Input D = ")) (setq e (getreal "\n Input E = ")) (setq f (getreal "\n Input F = ")) (setq startx (getreal "\n Input Start X = ")) (setq endx (getreal "\n Input End X = ")) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (* a x x x x x) (* b x x x x) (* c x x x) (* d x x) (* e x) f)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ylist (vl-sort ylist '<)) (setq ymin (car ylist)) (setq ymax (last ylist)) (setq ptlist (reverse ptlist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis startx endx ymin ymax steps) (princ) ) (defun c:yx6 ( / a b c d e f g startx endx steps deltax ptlist pt mspace tmp myobj ylist ) (princ "\n y = Ax^6 + Bx^5 + Cx^4 + Dx^3 + Ex^2 + Fx + G ") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq c (getreal "\n Input C = ")) (setq d (getreal "\n Input D = ")) (setq e (getreal "\n Input E = ")) (setq f (getreal "\n Input F = ")) (setq g (getreal "\n Input G = ")) (setq startx (getreal "\n Input Start X = ")) (setq endx (getreal "\n Input End X = ")) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (* a x x x x x x) (* b x x x x x) (* c x x x x) (* d x x x) (* e x x) (* f x) g)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ylist (vl-sort ylist '<)) (setq ymin (car ylist)) (setq ymax (last ylist)) (setq ptlist (reverse ptlist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis startx endx ymin ymax steps) (princ) ) (defun c:y2x2 ( / a b c startx endx steps deltax ptlist pt mspace tmp myobj xlist ylist xmin xmax ymin ymax ) (princ "\n (x - A)^2 + (y - B)^2 = C^2") (setq a (getreal "\n Input A = ")) (setq b (getreal "\n Input B = ")) (setq c (getreal "\n Input C = ")) (setq startx (- a c)) (setq endx (+ a c)) (setq steps 100) (cond ((<= startx endx) (setq x startx) ) ((> startx endx) (setq x endx) (setq endx startx) (setq startx x) ) ) (setq deltax (/ (- endx startx) steps)) (setq xlist '()) (setq ylist '()) (setq ptlist '()) (repeat (+ steps 1) (setq y (+ (sqrt (abs (- (+ (- (* c c) (* x x)) (* 2 a x)) (* a a)))) b)) (setq xlist (cons x xlist)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq ptlist (reverse ptlist)) (setq x startx) (repeat (+ steps 1) (setq y (+ (sqrt (abs (- (+ (- (* c c) (* x x)) (* 2 a x)) (* a a)))) b)) (setq y (- (* 2 b) y)) (setq xlist (cons x xlist)) (setq ylist (cons y ylist)) (setq pt (list x y 0.0)) (setq ptlist (cons pt ptlist)) (setq x (+ x deltax)) ) (setq xlist (vl-sort xlist '<)) (setq ylist (vl-sort ylist '<)) (setq xmin (car xlist)) (setq xmax (last xlist)) (setq ymin (car ylist)) (setq ymax (last ylist)) ; https://www.afralisp.net/archive/methods/list/addpolyline_method.htm (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (vlax-put-property myobj 'color 3) (ex:drawaxis xmin xmax ymin ymax steps) (princ) ) (defun ex:drawaxis ( xmin xmax ymin ymax steps / deltax xaxisline yaxisline xaxisarrow1 xaxisarrow2 xaxisarrow3 xaxisarrow4 yaxisarrow1 yaxisarrow2 yaxisarrow3 yaxisarrow4 xaxistext1 xaxistext2 yaxistext1 yaxistext2 ) (setq deltax (/ (- xmax xmin) steps)) (setq xaxisline (vla-addline mspace (vlax-3d-point (list (- xmin (* (/ steps 10) deltax)) 0 0))(vlax-3d-point (list (+ xmax (* (/ steps 10) deltax)) 0 0)))) (setq yaxisline (vla-addline mspace (vlax-3d-point (list 0 (- ymin (* (/ steps 10) deltax)) 0))(vlax-3d-point (list 0 (+ ymax (* (/ steps 10) deltax)) 0)))) (setq xaxisarrow1 (vla-addline mspace (vlax-3d-point (list (- xmin (* (/ steps 20) deltax)) (- 0 (* (/ steps 100) deltax)) 0))(vlax-3d-point (list (- xmin (* (/ steps 10) deltax)) 0 0)))) (setq xaxisarrow2 (vla-addline mspace (vlax-3d-point (list (- xmin (* (/ steps 20) deltax)) (+ 0 (* (/ steps 100) deltax)) 0))(vlax-3d-point (list (- xmin (* (/ steps 10) deltax)) 0 0)))) (setq xaxisarrow3 (vla-addline mspace (vlax-3d-point (list (+ xmax (* (/ steps 20) deltax)) (- 0 (* (/ steps 100) deltax)) 0))(vlax-3d-point (list (+ xmax (* (/ steps 10) deltax)) 0 0)))) (setq xaxisarrow4 (vla-addline mspace (vlax-3d-point (list (+ xmax (* (/ steps 20) deltax)) (+ 0 (* (/ steps 100) deltax)) 0))(vlax-3d-point (list (+ xmax (* (/ steps 10) deltax)) 0 0)))) (setq yaxisarrow1 (vla-addline mspace (vlax-3d-point (list (- 0 (* (/ steps 100) deltax)) (- ymin (* (/ steps 20) deltax)) 0))(vlax-3d-point (list 0 (- ymin (* (/ steps 10) deltax)) 0)))) (setq yaxisarrow2 (vla-addline mspace (vlax-3d-point (list (+ 0 (* (/ steps 100) deltax)) (- ymin (* (/ steps 20) deltax)) 0))(vlax-3d-point (list 0 (- ymin (* (/ steps 10) deltax)) 0)))) (setq yaxisarrow3 (vla-addline mspace (vlax-3d-point (list (- 0 (* (/ steps 100) deltax)) (+ ymax (* (/ steps 20) deltax)) 0))(vlax-3d-point (list 0 (+ ymax (* (/ steps 10) deltax)) 0)))) (setq yaxisarrow4 (vla-addline mspace (vlax-3d-point (list (+ 0 (* (/ steps 100) deltax)) (+ ymax (* (/ steps 20) deltax)) 0))(vlax-3d-point (list 0 (+ ymax (* (/ steps 10) deltax)) 0)))) (setq xaxistext1 (vla-AddText mspace "+x" (vlax-3d-point (list (+ xmax (* (/ steps 8) deltax)) 0 0)) (* (/ steps 20) deltax))) (vlax-put-property xaxistext1 'alignment 9) (setq xaxistext2 (vla-AddText mspace "-x" (vlax-3d-point (list (- xmin (* (/ steps 8) deltax)) 0 0)) (* (/ steps 20) deltax))) (vlax-put-property xaxistext2 'alignment 11) (setq yaxistext1 (vla-AddText mspace "-y" (vlax-3d-point (list 0 (- ymin (* (/ steps 8) deltax)) 0)) (* (/ steps 20) deltax))) (vlax-put-property yaxistext1 'alignment 7) (setq yaxistext2 (vla-AddText mspace "+y" (vlax-3d-point (list 0 (+ ymax (* (/ steps 8) deltax)) 0)) (* (/ steps 20) deltax))) (vlax-put-property yaxistext2 'alignment 13) (setq bar (* (/ steps 10) deltax)) (setq barlen (/ bar 6)) (setq index2 0) (repeat 11 (setq xbar (vla-addline mspace (vlax-3d-point (list (+ xmin (* bar index2)) barlen 0))(vlax-3d-point (list (+ xmin (* bar index2)) (* barlen -1) 0)))) (setq xbartext (vla-AddText mspace (rtos (+ xmin (* bar index2)) 2 0) (vlax-3d-point (list (+ (+ xmin (* bar index2)) (/ barlen 2)) (- 0 (/ barlen 2)) 0)) (/ (* (/ steps 20) deltax) 2))) (vlax-put-property xbartext 'alignment 6) (setq index2 (+ index2 1)) ) (setq index2 0) (repeat 11 (setq ybar (vla-addline mspace (vlax-3d-point (list barlen (+ ymin (* bar index2)) 0))(vlax-3d-point (list (* barlen -1) (+ ymin (* bar index2)) 0)))) (setq ybartext (vla-AddText mspace (rtos (+ ymin (* bar index2)) 2 0) (vlax-3d-point (list (- 0 (/ barlen 2)) (+ (+ ymin (* bar index2)) (/ barlen 4)) 0)) (/ (* (/ steps 20) deltax) 2))) (vlax-put-property ybartext 'alignment 14) (setq index2 (+ index2 1)) ) ) command list yx1 - linear equation y = Ax + B yx2 - quadratic equation y = Ax^2 + Bx + C yx3 - cubic equation y = Ax^3 + Bx^2 + Cx + D yx4 - biquadratic equation y = Ax^4 + Bx^3 + Cx^2 + Dx + E yx5 - quintic equation y = Ax^5 + Bx^4 + Cx^3 + Dx^2 + Ex + F yx6 - 6th y = Ax^6 + Bx^5 + Cx^4 + Dx^3 + Ex^2 + Fx + G y2x2 - circle equation (x-a)^2 + (y-b)^2 = c^2 This is a simple routine that just connects points with polylines and no curves. This is not an exact graph.
    1 point
  12. A quick modification to the link I posted, Same result, slightly different method to exceed - though a blatant copy here for the 'cond' part of his code. (defun c:layerElev ( / ss i pline elevation MyColour) (setq ss (ssget '((0 . "LWPOLYLINE")))) (if ss (progn (setq i -1) (repeat (sslength ss) (setq i (1+ i) pline (ssname ss i) elevation (cdr (assoc 38 (entget pline))) ) (cond ((= (rem elevation 5) 0)(setq MyColour 1)) ((= (rem elevation 1) 0)(setq MyColour 2)) ((= (rem elevation 0.5) 0)(setq MyColour 3)) (t (setq MyColour 1)) ) (command "chprop" pline "" "c" MyColour "") ) ) ) (princ) )
    1 point
  13. ; ELPOLY - 2022.06.20 exceed ; https://www.cadtutor.net/forum/topic/75461-help-lisp-set-color-for-polyline-based-on-elevation/ ; change lwpolyline's color by it's elevation ; 0, 5, 10, 15, 20... - change to red ; 1, 2, 3, 4, 5, 6, 7... - change to purple ; 1.5, 2.5, 3.5, 4.5, 5.5 ... - change to green ; 1.xxx, 2.xxx, 3.xxx ..... - change to green anyway ; if you want to change 4th option, just change ; (t ; (princ " , so change to green anyway") ; (vlax-put-property obj 'color 3) ; ) ; "3" of this part's after 'color. ; this is autocad indexed color number (vl-load-com) (defun c:ELPOLY ( / ss ssl index obj objelevation ) (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE")))) (progn (setq ssl (sslength ss)) (setq index 0) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq objelevation (vlax-get-property obj 'elevation)) (princ "\n it's elevation is = ") (princ objelevation) (cond ((= (rem objelevation 5) 0) (princ " , so change to red") (vlax-put-property obj 'color 1) ) ((= (rem objelevation 1) 0) (princ " , so change to purple") (vlax-put-property obj 'color 6) ) ((= (rem objelevation 0.5) 0) (princ " , so change to green") (vlax-put-property obj 'color 3) ) (t (princ " , so change to green anyway") (vlax-put-property obj 'color 3) ) ) (setq index (+ index 1)) ) ) (progn (princ "\n there's nothing to change") ) ) (princ) ) you can start with this
    1 point
  14. You would need to set major contour interval, minor contour interval, as the plines do have a Z its feasible, I will say though never had to do it multicoloured in like 40 years. So a bit one off. Will maybe try to find time.
    1 point
  15. Are all the polylines whole numbers (1 2 etc, not 1.34) and are they all 2d Polylines, not 3D? Second question is what are your abilities to write a LISP like? For example if we gave you a couple of hints would you be able to write this or would you need a nearly complete LISP to do the job Third question, did you search this forum? I am sure I saw similar in the last 2 or 3 months asking the same thing which can be a good starting point to modify7 to what you want. there will of course be someone out there with this as a complete solution, you might get lucky that they post you an answer with that as well -EDIT with the link:- I reckon if you look at this and change the line "(Command "Pline".... " to change the colour that might work but CAD is off today, Sunday you see so I can't check for you
    1 point
×
×
  • Create New...