Jump to content

Leaderboard

  1. mhupp

    mhupp

    Community Member


    • Points

      70

    • Posts

      917


  2. BIGAL

    BIGAL

    Trusted Member


    • Points

      55

    • Posts

      15,631


  3. exceed

    exceed

    Community Member


    • Points

      38

    • Posts

      216


  4. Steven P

    Steven P

    Community Member


    • Points

      37

    • Posts

      748


Popular Content

Showing content with the highest reputation since 05/28/2022 in all areas

  1. Believe it or not but I am Kenny Ramage. I cannot believe that AfraLisp is still having an influence.
    6 points
  2. Yeah, sure. Command TCCR. I let you first enter the width. Then, since you need that width multiple times I put the rest in a while loop. Of course you can hard code the width and remove the while if you want. ;; degrees to rad (defun deg2rad (deg / ) (/ (* deg pi ) 180) ) ;; draws a polyline (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst)))) ;; TCCR for: Two Click Centerline Rectangle (defun c:TCCR ( / w ang p1 p2 bl br tl tr) (setq w (getreal "\nWidth: ")) (while (setq p1 (getpoint "\nPoint 1:")) (setq p2 (getpoint "\nPoint 2:" p1)) ;; calculate bottom/left, bottom/right,... (setq ang (angle p1 p2)) (setq bl (polar p1 (- ang (deg2rad 90.0)) (/ w 2.0))) (setq tl (polar p1 (+ ang (deg2rad 90.0)) (/ w 2.0))) (setq br (polar p2 (- ang (deg2rad 90.0)) (/ w 2.0))) (setq tr (polar p2 (+ ang (deg2rad 90.0)) (/ w 2.0))) (drawLWPoly (list bl br tr tl) 1) ) )
    4 points
  3. https://www.afralisp.net/ is nice with simple step by step instructions. https://www.cadtutor.net/tutorials/autolisp/quick-start.php also good start but one page. Coming to the forums regularly to see how people problem solve. look for answer from people with high scores. there are multiple ways to code things in lisp. usually it comes down to performance (what runs the fastest) but depending on user preference or other factors one type of code might win out over a faster code. Reading over the functions to understand how to use them. https://help.autodesk.com/view/OARX/2023/ENU/?guid=GUID-4CEE5072-8817-4920-8A2D-7060F5E16547 Welcome and hope to see you around.
    4 points
  4. ; 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.
    4 points
  5. Kenny Ramage here. (AfraLisp) Semi retired now but would like to help out especially with the basics.
    4 points
  6. updated the lisp with the following - entmake for point and text (faster) - got rid of nth its slower then then car cadr caddr last - updated while to combined lines of code Also I don't think the easting and northing are in the right order but left it like the lisp had it. so if your points are in the wrong spot maybe update to below (setq POINT (list (cadr POINT_LINE) ;Get x (caddr POINT_LINE) ;Get y (last POINT_LINE) ;Get z ) ) ; POINTPLT is a simple AutoLSIP program that will plot a coordinate points file ; in AutoCAD. To run POINTPLT, load POINTPLT.LSP as you would any normal ; AutoLISP file (see AutoCAD Reference Manual), type "POINTPLT" and press ; [Enter]. POINTPLT will first prompt you for an input coordinate filename. ; You must enter a vaild DOS filename at this point. The input coordinate file ; must be in the following format: ; ; POINT NO. NORTHING(y) EASTING(x) ELEVATION(z) ; ; A sample input coordinate file (SAMPLE.DAT) is included with POINTPLT. ; ; POINTPLT uses the default (current) text style and layer. However, the ; current text style must have a defined height (height must not be "0"). ; ; If you have any questions or comments concerning POINTS, I may be reached ; via THE SPECTRUM BBS þ (501) 521-5639 ; ;------------------------------------------------------------------------------- ; * ERROR Trapping * ; (defun *ERROR* () (eop) ) ;------------------------------------------------------------------------------- ; * End of program * ; (defun EOP () (setvar "CMDECHO" POINTSPLT_CE) (princ) ) ;------------------------------------------------------------------------------- ; * Main Program * (defun C:POINTPLT (/ IN_FILE POINT_LINE POINT_NO POINT) (setq POINTSPLT_CE (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;Turn "Command Echo" off (prompt "\n\nP O I N T P L T v1.0 -- Copyright (c) 1992 by Kurtis J. Jones / -Mate Software\n\n") (setq IN_FILE (open (getfiled "\nEnter points filename: " (getvar 'DWGPREFIX) "txt" 16) "r")) (while (setq POINT_LINE (read (strcat "(" (read-line IN_FILE) ")"))) ;Read POINT_LINE from input file (setq POINT_NO (car POINT_LINE)) ;Get the point number (prompt (strcat "\nPlotting point no. " (itoa POINT_NO))) (setq POINT (list (caddr POINT_LINE) ;Get easting (cadr POINT_LINE) ;Get northing (last POINT_LINE) ;Get elevation ) ) (entmake (list '(0 . "POINT") (cons 10 POINT))) (entmake (list '(0 . "TEXT") (cons 10 POINT) '(40 . 1) (cons 1 (itoa POINT_NO)))) ) (close IN_FILE) (prompt "\nPOINTPLT finished") (prompt "\n ") (eop) )
    4 points
  7. You can create as many layer states as you need. If you have two viewports in your layout, you can create a layer state for each one to display different layers in each viewport. But, if you go into model space and start freezing layers, as tombu mentioned, that will affect your viewport display when you go back to your layout and those layers that you froze in model space will no longer be visible in your viewports. I believe this is the problem you are describing. Once you create your layer states, it's best to leave model space alone. Just work inside your viewports.
    4 points
  8. Try this ... does not check for locked layers. (defun c:foo (/ a i o s) (if (setq s (ssget "_X" '((0 . "TEXT") (1 . "* .#,* .##,* .###")))) (foreach e (mapcar 'cadr (ssnamex s)) (setq a (vla-get-textstring (setq o (vlax-ename->vla-object e)))) (setq i (vl-string-position 32 a 0 t)) (vla-put-textstring o (substr a 1 i)) ) ) (princ) )
    4 points
  9. Why not just copy and paste all 3 into one lisp ? 1 Hint centroid can be 1 line of code using a inbuilt function. (setq obj (vlax-ename->vla-object (entlast))) (setq cpt (osnap (vlax-curve-getStartPoint obj) "gcen")) 2 lot of code for insert block ? Just check does exist if not make it as you only need 1 att. I would remove (getstring "\nName of block to insert: ") use a hard coded block name so exists in your DWT. 3 Lee's code is great but as you know the block that you inserted step 2 just edit the attribute with the field answer no need for a total 3rd program. The answer for the att string is in Lee's code. So the steps Select all plines making selection set Loop through selection Insert block at centroid Amend block attribute string value to field Repeat for all plines. Maybe 100 lines of code probably less. I have not posted any code as did you google "label area multiple pline autocad lisp"
    3 points
  10. Don't know if you want metric or imperial, but I uploaded a zip with a full set of metric ones some years ago: https://www.cadtutor.net/forum/topic/62352-titleblock/?tab=comments#comment-514547
    3 points
  11. Forgot to add just take a existing drawing as a start and erase all objects but dont do a purge and add more to it, like Tombu use Lee's steal.
    3 points
  12. (setq IN_FILE (open (getfiled "\nSelect Points File" (getvar 'DWGPREFIX) "txt" 16) "r")) This will start in the same folder as the drawing change "txt" to the file extension your looking for. --edit-- I would also make sure to the file is formatted correctly. when I make a point its asking for x y z cords in that order but the lisp seems to be pulling P# y x z. Also Im on BrisCAD so i had to update the text command to work properly
    3 points
  13. Just taking a shot and what I assume you're looking for: edit: forgot about the rounding part oops. Gonna see what I can do there if anything. edit2: Threw in Lee Mac's roundm function, but I haven't tested it. Still no fractions edit3: I think I broke it... You can change DISTR to DIST to just get the length with no rounding for now if you'd like, it'll work in that way. edit4: Fix'd-er up, and it displays fractions! (I'm also pretty sure the code could be a bit better. I change the data-type of DIST and DISTR probably needlessly) (defun LM:roundm (n m) ;gotta love Lee Mac (http://www.lee-mac.com/round.html) (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) ) (defun c:linelength (/ s e) ;function taken from helpful post by Tharwat @ https://www.cadtutor.net/forum/topic/55856-lisp-to-get-length-of-single-line/ (princ "\n Pick on one line to get its length :") (if (setq s (ssget "_+.:S:E" '((0 . "LINE")))) (progn (setq DIST (rtos (distance (cdr (assoc 10 (setq e (entget (ssname s 0))))) (cdr (assoc 11 e))) 2)) (setq DISTR (LM:roundm (distof DIST) 0.125)) (setq DISTR (rtos DISTR 5)) (command "TEXT" PAUSE PAUSE 90 DISTR) (princ) ) ) ) You select the line, then select where you want the text of the length to be placed, then choose a size for the text. It then plops it where you set with the 90* rotation applied. Hope that helps
    2 points
  14. Likewise I have a similar LISP on startup, the variables I like to use (might be stealing some of that list) and loading the LISPs I most often use. Taking BigAls LISP a bit further, I have one "Appreload" which loads all the LISP files in my library, which could also be run at start up, can be modified to princ each lisp file name as it loads (defun c:appreload ( / lspname myfiles acount mylistlength Failedtoload) ;;Re-load named LISP files (setq mylispfolder "C:\\Users\\wherever\\") ;;;;;; change this line ;;;;;;;;; ;;;;;;; edit for laptop ;;;;;;; Laptop maps company driver differently to desktop so added this (if (= (findfile "C:\\Users\\wherever\\SIMPLELISP.lsp") nil) ;;;; if it can find this file do nothing.. use anyfile in your library (setq mylispfolder "C:\\Users\\lapTop File Location\\") ) (setq myfiles (vl-directory-files mylispfolder "*.lsp" nil)) ;;myfiles is list of files in mylispfolder location (setq mylistlength (length myfiles)) ;;count of number of lsp files (setq acount -1) (repeat mylistlength (setq acount (1+ acount)) (setq FailedtoLoad (strcat (nth acount myfiles) " failed to load")) (load (strcat mylispfolder (nth acount myfiles)) FailedtoLoad) ;;Loads each LISP file ) (princ "\n") (princ mylistlength) (princ " lsp files loaded from ") (princ mylispfolder) (princ) ) and one for mhupp, snaps (AutoCAD, not sure if Bricscad does it the same way? ;;Snaps. ( * 1.. to use snap, ( * 0 to turn off snap. (setq snaps 0) (setq snaps (+ snaps (* 1 0))) ;None (setq snaps (+ snaps (* 1 1))) ;End Point (setq snaps (+ snaps (* 1 2))) ;Mid Point (setq snaps (+ snaps (* 1 4))) ;Centre (setq snaps (+ snaps (* 0 8))) ;Node (setq snaps (+ snaps (* 0 16))) ;Quadrant (setq snaps (+ snaps (* 1 32))) ;Intersection (setq snaps (+ snaps (* 0 64))) ;Insertion (setq snaps (+ snaps (* 0 128))) ;Perpendicular (setq snaps (+ snaps (* 1 256))) ;Tangent (setq snaps (+ snaps (* 0 512))) ;Nearest (setq snaps (+ snaps (* 0 1024))) ;Geometric Centre (setq snaps (+ snaps (* 1 2048))) ;Apparent Intersection (setq snaps (+ snaps (* 0 4096))) ;Extrnsion (setq snaps (+ snaps (* 0 8192))) ;Parallel (setq snaps (+ snaps (* 0 16348))) ;Superess all running snaps (setvar 'osmode snaps)
    2 points
  15. This is my on on_doc_load.lsp for BricsCAD in "C:\...\BricsCAD\Support" to help keeping a standard between drawings. (setvar 'cmdecho 0) (setvar 'INSUNITS 1) ; Sets the Drawing units to inches (setvar 'THICKNESS 0) ; Sets THICKNESS TO 0 (setvar 'CECOLOR "BYLAYER") ; Sets color property to "BYLAYER." (setvar 'CELTYPE "BYLAYER") ; Sets linetype property to "BYLAYER." (setvar 'CELWEIGHT -1) ; Sets the lineweight to "BYLAYER." (setvar 'CELTSCALE 1) ; Sets the LTScale of new objects to 1. (setvar 'plinetype 2) ; convents all 2D polylines to optimized polylines (setvar 'auprec 4) ; angular unit percision 0.0000 (setvar 'luprec 4) ; linear unit percision 0.0000 (setvar 'selectionmodes 0) ; Set Selection mode to 0 (setvar 'lunits 2) ; Set Linear units to Decimal (setvar 'perspective 0) ; Turn off Perspective view in current viewport ;(setvar 'saveformat 8) ; Set save to 2010 DXF ;might not want this one. have it set for cnc software we use (setvar 'nomutt 1) (vl-cmdf "_.Style" "Standard" "Consolas" "" "" "" "" "") (setvar 'nomutt 0) (setvar 'cmdecho 1)
    2 points
  16. ooo another way. (strcat (chr 92) "46.48.10random IP\...")
    2 points
  17. Are the widths fixed size if so look at my Multi radio buttons.lsp can have the sizes pre programmed. (setq ans (atoi(ah:butts ahdef "V" '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")))) Multi radio buttons.lsp
    2 points
  18. I have a custom lisp with all my defuns in it so load on start up. (defun C:zzz ( / ) (load "blahblah.lsp")). See Autoload.lsp below Appload.
    2 points
  19. https://www.cadtutor.net/forum/topic/75450-change-numbers-alphabet-column-numbers/ how about this, can convert number 1 ~ 12356630 But I lost to Gilles, haha It is super simple and correct, it supports up to the limit of fix num, so the range is wider. it's mathematically interesting. It has been a study for me.
    2 points
  20. Get a copy of Notepad++ a text editor has functions built in that helps when writing lisp's. A lot of us use it.
    2 points
  21. As you say if blocks are a mix then a problem. The solution appears to be 2 steps not one. You should be able to stop in your script, been a while, generally its no user input, any way a script can have lisp code in it or call a lisp program that program may have a stop and ask a question. Only a quick look but add set units.lsp to your Appload Start up suite then the functions will be available. remove the (command ".script" (strcat folderName "\\batchJob.scr")) in batchjob code. Your batchjob1.scr should be, (BatchJob) (command ".script" (strcat folderName "\\batchJob.scr")) The script needs (c:UNITSET) to be added after open dwg1 etc in batchjob I think that is what you need. Not tested. open dwg1 (c:UNITSET) close Y open dwg2 (c:UNITSET) close Y You dont need lee's bounding box can just load the boundingbox lisp as part of the script.
    2 points
  22. As a non-Lisperatti,, and yet aspiring to help... Are you familiar with the commandline command " -dwgunits" YES, the leading hyphen is important, and needs to be included. Expand your commandline window to about 6 or 8 lines, to better understand all of the options which are available, and give you an accurate overview. It is a very powerful command, read all the options and go slowly. Take it around the block and kick the tires before running it on the real files, but it might be a command which you could include in a script, and run on all of your blocks. Consistency is important, there must be an in house company standard, right? Or should I say, there SHOULD be? Maybe you need them in both metric and Imperial? You could do that too, or UNITLESS? I hope that might help.
    2 points
  23. fas is "Compiled Fast-Load AutoLISP" The machine automatically optimizes it in a form that is easy to understand and fast. machine cannot understand lisp with alphabet in fact. every that code needs translation.
    2 points
  24. ; 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
    2 points
  25. If your going to start from scratch here is a little trick to get the maximum print area. Once the page size is set create a viewport and use the fit option. This creates a viewport on the dashed lines in paper space. (the maximum print area) You now have something to snap to when drawing a rectangle. That rectangle will need to be offset in a small distance. Then just delete the viewport and larger rectangle. you can now create a title block within said rectangle.
    2 points
  26. Coming back to this one again, this version uses the same idea I had above but closes each dialogue box and opens a new one which gets past the 8 children problem There are 4 defuns in this, one for each tab (create more or less as you want), and currently they return the variable 'MyTab'. If you want to keep any variables entered into a dialogue I would have 'MyTab' as a list, the first item being the selected next tab to go to, and after that include in the list all the other variables, perhaps for the full dialogue box, and update that as the user selects controls. Am sure you can work out passing numbers backwards and forwards and repopulating the dialogue boxes with that. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab1 ( / dcl1 des1 dch1 x MyTab) ;;;DCL 1 ;;DCL on the fly: Ideas by Lee Mac and Cadtutor forums ;;create DCL pop up box (if (and (setq dcl1 (strcat (getvar "TEMPPREFIX") "DCLTab1.dcl")) (setq des1 (open dcl1 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"A Dialogue Box\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 1'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Lets Make DCL!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"and put all the fun bits here\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des1) ) (not (setq des1 (close des1))) (< 0 (setq dch1 (load_dialog dcl1))) (new_dialog "pass" dch1) ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(term_dialog)(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(term_dialog)(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(term_dialog)(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(term_dialog)(done_dialog 1)") (action_tile "accept" "(done_dialog 1)(term_dialog)") (action_tile "cancel" "(done_dialog 0)(term_dialog)") (start_dialog) ) ;;end of DCL1 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL1 'if' above (vl-file-delete dcl1) ;;delete the temp DCL file MyTab ) ; end defun tab 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab2 ( / dcl2 des2 dch2 x MyTab) (if (and (setq dcl2 (strcat (getvar "TEMPPREFIX") "DCLTab2.dcl")) (setq des2 (open dcl2 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"Popped Up to say Hello\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 2'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Aha!! Tab 2!!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"put more fun bits here\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des2) ) (not (setq des2 (close des2))) (< 0 (setq dch2 (load_dialog dcl2))) (new_dialog "pass" dch2) (princ "Tab 2 Loaded") ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(term_dialog)(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(term_dialog)(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(term_dialog)(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(term_dialog)(done_dialog 1)") (action_tile "accept" "(done_dialog 1)(term_dialog)") (action_tile "cancel" "(done_dialog 0)(term_dialog)") (start_dialog) ) ;;end of DCL2 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL2 'if' above (vl-file-delete dcl2) ;;delete the temp DCL file MyTab ) ; end defun tab 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab3 ( / dcl3 des3 dch3 x MyTab) (if (and (setq dcl3 (strcat (getvar "TEMPPREFIX") "DCLTab3.dc3")) (setq des3 (open dcl3 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"The popped away again\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 3'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Now your talking, Tab 3!!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"good this,\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des3) ) (not (setq des3 (close des3))) (< 0 (setq dch3 (load_dialog dcl3))) (princ "Tab 3 Loaded") (new_dialog "pass" dch3) ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(term_dialog)(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(term_dialog)(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(term_dialog)(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(term_dialog)(done_dialog 1)") (action_tile "accept" "(done_dialog 1)(term_dialog)") (action_tile "cancel" "(done_dialog 0)(term_dialog)") (start_dialog) ) ;;end of DCL3 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL3 'if' above (vl-file-delete dcl3) ;;delete the temp DCL file MyTab ) ; end defun tab 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Tab4 ( / dcl4 des4 dch4 x MyTab) (if (and (setq dcl4 (strcat (getvar "TEMPPREFIX") "DCLTab4.dcl")) (setq des4 (open dcl4 "w")) (foreach x '( " pass : dialog" " {" " key = \"Lispdialoguebox\";" " label = \"This is Tab 4 by the way\";" " spacer;" " : column { width=80;" " : row {" " : button { key = \"Tab1\"; label = \"Tab1\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab2\"; label = \"Tab2\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab3\"; label = \"Tab3\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " : button { key = \"Tab4\"; label = \"Tab4\"; is_default = false; is_cancel = true; fixed_width = true; width = 20;}" " spacer;" " }" " }" " : boxed_column { width=80; label = \"A TITLE HERE 'Tab 4'\";" " : row { width=80; alignment = centered;" " : column {width = 20; alignment = centered;" " :row {alignment = bottom;" " : text { key = \"text1-a\"; label = \"Look who'se talkng!!\"; width = 20; alignment = right;}" " }" " : row {width = 40; alignment = left;" " : text { key = \"text1-b\"; label = \"to you. Anopther Tab!!\"; width = 20; alignment = right;}" " }" " }" " }" " }" " : boxed_column { width=80; alignment = left;" " : row {" " : column {width = 18; alignment = centered;" " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" " }" " : column {width = 18; alignment = centered;" " : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }" " }" " }" " }" " }" ) (write-line x des4) ) (not (setq des4 (close des4))) (< 0 (setq dch4 (load_dialog dcl4))) (princ "Tab 4 Loaded") (new_dialog "pass" dch4) ) ;;End of DCL pop up box definition (progn ;;makes a pop-up list box (action_tile "Tab1" "(Setq MyTab \"Tab1\")(done_dialog 1)") (action_tile "Tab2" "(Setq MyTab \"Tab2\")(done_dialog 1)") (action_tile "Tab3" "(Setq MyTab \"Tab3\")(done_dialog 1)") (action_tile "Tab4" "(Setq MyTab \"Tab4\")(done_dialog 1)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (start_dialog) ) ;;end of DCL4 'and' above (princ "\nError. Unable to load dialogue box.") ) ;;end of DCL4 'if' above (vl-file-delete dcl4) ;;delete the temp DCL file MyTab ;;change this to a list with all variables in it. Repopulate tab when it is opened again ) ; end defun tab 4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:testthis ( / ) (setq MyTab (Tab1)) (setq Done "Not") (while (= Done "Not") (if (= MyTab nil)(setq Done "Yes")) (if (/= MyTab nil)(setq MyTab (eval (read (strcat "(" MyTab ")"))) ) ) ); end while
    2 points
  27. I have a program that does this. It also adds each closed polyline area and tag into a sql database that be queried. It can then display it on a website. Sure it cost $250k to buy and install and costs us about $25K annually. It's called Archibus. Look over at leemac's website to see what he has... http://www.lee-mac.com/arealabel.html
    2 points
  28. I have a few basic templates that include blocks, styles, layers and layer states we use for all our drawings. Everything else like page setups, layouts with title blocks and additional text & dimension styles are imported using Lee Mac's Steal from Drawing macros. Too many sizes & types of layouts & title blocks to include them all in a new drawing from a template.
    2 points
  29. Welcome to CADTutor Kenny!! I still refer to AfraLisp from time to time to brush up on things.
    2 points
  30. Thanks for helping so many of us get started!
    2 points
  31. The same way you did deduct the first element ( X coordinates ) although it has to be car and not cadr (setq co (list (- (car co) 15.0) ;; X = (car co) so now it is minus 15.0 from oroginal X value. (- (car co) 10.0) ;; Y = (cadr co) so now it is minus 10.0 from original Y value. ) )
    2 points
  32. about the point name issue: if there are spaces ( like @mhupp wrote) or Special Characters (like @BIGAL wrote): 1. open the .txt file in excel, and in text import wizard choose "as fixed width". 2. after the file is open select the name column. 3. go to Home -> Find&select -> Replace 4. replace the spaces and/or the Special Characters with appropriate Character (I usually go with "_"). 5. save the file (if save is selected the file will remain .TXT) or "save as...", and make sure to save as "Text (Tab Delimited) (*.TXT)" * as a comment I must add that is one of the most simple and useful lisp I've seen lately. thanks @psychopomp1 for the post and @mhupp for making it works....
    2 points
  33. I guess you could make a temp copy of the polyline to explode and overkill. Check the total length of entity's left against the length of the unexploded polyline. original length = non returning length original length > returning length -edit You would then even know for what length its overlapping. -edit added lisp : RETURN Select entities: Polyline has 113.886 of overlap : RETURN Select entities: Polyline does not overlap ;;----------------------------------------------------------------------------;; ;; Check if a polyline is overlapping (defun C:RETURN (/ len len+ ss ss1 ent objs LastEnt) (setq len 0.0 len+ 0.0 ss (ssadd) ) (if (setq ss1 (ssget "_+.:E:S" '((0 . "*POLYLINE")))) (progn (setq ent (ssname ss1 0)) (setq len (+ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))) (setq LastEnt (entlast)) (setq objs (vlax-invoke (vlax-ename->vla-object ent) 'explode)) (foreach ent (mapcar 'vlax-vla-object->ename objs) (ssadd ent ss) ) (setvar 'nomutt 1) (command "-overkill" ss "" "") (setvar 'nomutt 0) (if (setq en (entnext LastEnt)) (while en (ssadd en SS) (setq en (entnext en)) ) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (entget e) (progn (setq len+ (+ len+ (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))) (entdel e) ) (ssdel ent ss) ) ) (if (> len len+) (prompt (strcat "\nPolyline has " (rtos (- len len+) 2 3) " of overlap")) (prompt "\nPolyline does not overlap") ) ) ) (princ) )
    2 points
  34. I guess it has something to do with how they build the list. txt file point 1 100.235 200.374 56.356 read-line converts it to one string "point 1 100.235 200.374 56.356" (read (strcat "(" .... ")" turns it into a list (point 1 100.235 200.374 56.356) = list of 5 items because of space (car POINT_LINE) = point (caddr POINT_LINE) = 100.235 ; should be 200.374 (cadr POINT_LINE) = 1 ;should be 100.235 (last POINT_LINE) = 56.356 ;correct I guess you could pull the z y and x in that order using (last) and removing them from the list then anything left convert to point_name? Agree
    2 points
  35. my first thought didn't work with lists that have duplicate values. (setq w (vl-remove (last w) w)) '(15 25 25 25 25 35 35 35 35 50 50 50 50 50 50) to '(15 25 25 25 25 35 35 35 35) then I was like if their was only a way to take away the last item like cdr does with the first.
    2 points
  36. .. I was suitably impressed with reverse-reverse, hadn't thought of that
    2 points
  37. Good thinking. Cant look it up right now but must be a way to trim down a list so lenght is x. -edit vl-remove-if (> vl-postion (vla-get-columns obj)) maybe? (defun c:TW (/ c w ss ent obj row) (vl-load-com) (if (setq ss (ssget '((0 . "ACAD_TABLE")))) ;selects only tables (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq c '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (setq w '(15 25 25 25 25 35 35 35 35 50 50 50 50 50 50)) (setq obj (vlax-ename->vla-object ent)) (repeat (- (length w) (vla-get-columns obj)) (setq w (reverse (cdr (reverse w)))) (setq c (reverse (cdr (reverse c)))) ) (mapcar (function (lambda (a b) (vla-setcolumnwidth obj a b))) c w) (vla-setrowheight obj 0 10) (setq TotalRowCount (vla-get-rows obj)) (setq RowNumber 1) (while (< RowNumber TotalRowCount) (vla-setrowheight obj RowNumber 6) (setq RowNumber (+ RowNumber 1)) ) ) (prompt "\nNothing Selected") ) (princ) )
    2 points
  38. If the columns are always the same with for the same column number (eg, column 3 is always 25) then you could make a reference list of all these widths and refer to that, a bit more versatile maybe if that is so. Quickly something like below could work? You'd probably want to tidy it up using repeat, cdr, cadr and things like that to create your lists (defun c:trytthis ( / columns columnwidths usercols allcolumns acount) ;; (setq usercols (getint "Columns?")) (setq allcolumns (list 15 25 25 25 25 35 35 35 35 50 50 50 50 50 50 50 50 50 50)) ;A list of all column widths by column number (setq usercols (vla-get-columns obj) ) (setq acount 0) (while (< acount usercols) (setq columns (append columns (list acount))) (setq columnwidths (append columnwidths (list (nth acount allcolumns)))) (setq acount (+ acount 1)) ) )
    2 points
  39. 2 points
  40. IIRC, you can do Tabs in a VBA User Form. Like mentioned, OpenDCL, but needs installed on all machines, which may not be a big deal or could be a show stopper. As mentioned AutoCAD DCL doesn't do tabs, you will have to fake it, plain and simple. Go HERE and check out DCL_Tiles
    2 points
  41. the goat has something for this. http://www.lee-mac.com/copytodrawing.html
    2 points
  42. Here is the final lisp, I've added the option for the user to choose if to add the background mask or not. ;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;; ;; fixo () 2012 * all rights released ;; edited 3/3/12 ;; label lines (Pipes) with layer name (defun C:DIMLPDET_UPDATE2(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (cond ((or (not msg) (member msg '("console break" "Function cancelled" "quit / exit abort")) ) ) ((princ (strcat "\nError: " msg))) ) (princ) ) (initget "Current Pipe") (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: "))) (setq YN "Pipe") ) (initget "Yes No") (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: "))) (setq Bg "No") ) (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1000>: ")) (if (= ht nil) (setq ht (atof "1000")) ) (setq ht (/ 1 ht)) (setq txh1 (getreal "\nEnter text height<36>: ")) (if (= txh1 nil) (setq txh1 36) ) (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: ")) (if (= pipetype "") (setq pipetype "PVC PIPE") ) (setq a (substr " " 1 1)) (setq pipetype (strcat pipetype a)) ; (setq pipepn (strcase (getstring "\nPipe Type</6>: "))) ; (if (= pipepn "") ; (setq pipepn "/6") ; ) (setq offst (/ txh1 2)) (setq insut (getvar "insunits")) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) acsp (vla-get-block(vla-get-activelayout adoc))) (vla-startundomark adoc ) (setq txh txh1 prex (getvar "dimdec") ) (while (not sset) (setq sset (ssget '((0 . "*LINE"))) ) ) (while (setq en (ssname sset 0)) (setq curve (vlax-ename->vla-object en)) ;;(setq txt1 (rtos (vla-get-length curve) 2 2)) (setq txtln (if (= (getvar "measurement") 0) (rtos (vla-get-length curve) 3 2) (rtos (vla-get-length curve) 2 2)) ) (setq txtln (atof txtln)) (setq txtln (rtos (* txtln ht) 2 2)) (setq LAYERNAME (vla-get-layer curve)) (setq mid (/ (abs (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve))) 2.) mp (vlax-curve-getpointatparam curve mid) deriv (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve mp)) ) (if (zerop (cadr deriv)) (setq ang 0) (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv))))) ) (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ pi ang)) ) ;;; (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5)) ;;; ) (setq ppt1 (polar mp (+ ang (/ pi 2)) offst) ) (setq txtpt1 (vlax-3d-point (trans ppt1 1 0))) ;;; (setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(setq txt (strcat LAYERNAME pipepn)) (setq txt (strcat LAYERNAME " L=" (strcat txtln "m"))) (setq txt (vl-string-subst pipetype "P_" txt)) (setq txt (vl-string-subst "/" "-" txt)) (setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt)) (vla-put-AttachmentPoint theMText acBottomCenter) ;;(vla-put-alignment theMText acAlignmentBottomCenter) ;;(vla-put-textalignmentpoint theMText txtpt1) ;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText)) (vla-put-rotation theMText ang) (vla-put-Height theMText txh) (if (= Bg "Yes") (progn (vla-put-backgroundfill theMText :vlax-true) (setq dxf_ent (entget (entlast))) (entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0)))) ) ) (if (= YN "Pipe") (vlax-put-property theMText 'layer LAYERNAME) ) ;(setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(vla-put-alignment txt1 acAlignmentBottomCenter) ;(vla-put-textalignmentpoint txt1 txtpt1) ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1)) ; (vla-put-rotation txt1 ang) ;(if (= YN "Pipe") ; (vlax-put-property txt1 'layer LAYERNAME) ; ) (ssdel en sset) ) (*error* nil) (princ) ) (princ "\n\t---\tStart command with \"DIMLPDET\"\t---") (princ) (or (vl-load-com) (princ)) ;;------------------------------------ code end ----------------------------------;;
    2 points
  43. Would this work? (from https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mtext-background-mask-settings-lisp/td-p/5998702) Add this in after you have created each mtext or go back to the link above and do it by selection set (setq dxf_ent (entget (entlast)) (entmod (append dxf_ent '((90 . 1) (63 . 8) (45 . 1.1) (441 . 0))))
    2 points
  44. Glad you could make use it. Definitely test it out before shredding a directory of drawings. The filter will only grab end numbers up to 3 digits long so if there are any longer than that just keep adding # like so separated by commas: (1 . "* .#,* .##,* .###,* .####,* .#####")
    2 points
  45. ; CNC - 2022.05.31 exceed ; https://www.cadtutor.net/forum/topic/75276-an-offset-marco-for-cnc-plasma-cutting-process/ ; ; Works on closed polylines, circles. ; Objects with the largest area are offset outward, others are offset inward. ; ; Command List ; CNC - do offset ; @Q - Save and close all opened drawings. Dialogs do not appear individually when closing each drawing. Appears only once for confirmation. ; ; The color is designated as number 3 (green). The layer does not change. ; ; Edit 10 in (setq offsetvalue 10) to adjust the offset length ; ; When you add this Lisp to your starter set, it will work automatically every time you open a drawing. ; Open multiple drawings and save and close them all with the @Q command. ; If you want to manually, add ; in front of (c:CNC) to make ;(c:CNC), ; it will work when manually entering CNC ; ; Note ; If you reopen a drawing that has already been executed and saved, it will be created again. ; In this part, it seems to be necessary to add a statement that does not execute if there is a green object in the drawing. ; Your green looks different than mine, so I didn't add this code. (vl-load-com) (defun c:CNC ( / offsetvalue ss ssl index arealist obj objarea objlist outerloopobj outeroffset otherloop otherlooplen index2 otherloopobj inneroffset ) (setq offsetvalue 10) (setq ss (ssget "X" '((0 . "LWPOLYLINE,CIRCLE")))) (setq ssl (sslength ss)) (setq index 0) (setq arealist '()) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq objarea (vla-get-area obj)) (setq objlist (list obj objarea)) (setq arealist (cons objlist arealist)) (setq index (+ index 1)) ) (setq arealist (vl-sort arealist (function (lambda (x1 x2) (> (cadr x1) (cadr x2)) ) ))) (setq outerloopobj (car (car arealist))) (setq outeroffset (ex:offsetout outerloopobj offsetvalue)) (vlax-put-property outeroffset 'color 3) (setq otherloop (cdr arealist)) (setq otherlooplen (length otherloop)) (setq index2 0) (repeat otherlooplen (setq otherloopobj (car (nth index2 otherloop))) (setq inneroffset (ex:offsetin otherloopobj offsetvalue)) (vlax-put-property inneroffset 'color 3) (setq index2 (+ index2 1)) ) (princ) ) (defun ex:offsetin ( obj offdis / subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length objloop) (vla-offset obj (* offdis 1)) (setq subloop1 (vlax-ename->vla-object (entlast))) (vla-offset obj (* offdis -1)) (setq subloop2 (vlax-ename->vla-object (entlast))) (setq subloop1type (vlax-get-property subloop1 'entityname)) (setq subloop2type (vlax-get-property subloop2 'entityname)) (cond ((= subloop1type "AcDbPolyline") (setq subloop1length (vlax-get-property subloop1 'length)) ) ((= subloop1type "AcDbCircle") (setq subloop1length (vlax-get-property subloop1 'Circumference)) ) ((= subloop1type "AcDbArc") (setq subloop1length (vlax-get-property subloop1 'Radius)) ) );end of cond (cond ((= subloop2type "AcDbPolyline") (setq subloop2length (vlax-get-property subloop2 'length)) ) ((= subloop2type "AcDbCircle") (setq subloop2length (vlax-get-property subloop2 'Circumference)) ) ((= subloop2type "AcDbArc") (setq subloop2length (vlax-get-property subloop2 'Radius)) ) );end of cond (cond ((> subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq objloop subloop2))) ((< subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1))) ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1))) ) objloop ) (defun ex:offsetout ( obj offdis / subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length objloop) (vla-offset obj (* offdis 1)) (setq subloop1 (vlax-ename->vla-object (entlast))) (vla-offset obj (* offdis -1)) (setq subloop2 (vlax-ename->vla-object (entlast))) (setq subloop1type (vlax-get-property subloop1 'entityname)) (setq subloop2type (vlax-get-property subloop2 'entityname)) (cond ((= subloop1type "AcDbPolyline") (setq subloop1length (vlax-get-property subloop1 'length)) ) ((= subloop1type "AcDbCircle") (setq subloop1length (vlax-get-property subloop1 'Circumference)) ) ((= subloop1type "AcDbArc") (setq subloop1length (vlax-get-property subloop1 'Radius)) ) );end of cond (cond ((= subloop2type "AcDbPolyline") (setq subloop2length (vlax-get-property subloop2 'length)) ) ((= subloop2type "AcDbCircle") (setq subloop2length (vlax-get-property subloop2 'Circumference)) ) ((= subloop2type "AcDbArc") (setq subloop2length (vlax-get-property subloop2 'Radius)) ) );end of cond (cond ((< subloop1length subloop2length) (progn (vla-delete subloop1) (setq looplength subloop2length) (setq objloop subloop2))) ((> subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1))) ((= subloop1length subloop2length) (progn (vla-delete subloop2) (setq looplength subloop1length) (setq objloop subloop1))) ) objloop ) ; close all by Middleton, Cliff ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/early-christmas/m-p/777308/highlight/true#M2966 (defun C:@Q nil (cond ((= 6 (LM:popup "Close All with Save" "You want close all with save?" 36)) (@CloseWithSave) (command "_close" "n") ) (t (princ "\nCanceled")) ) (princ) ) (defun @CloseWithSave ( / cnt) (setq cnt (@CloseAllButActive :vlax-True)) (if (> cnt 0) (princ (strcat "\n[ " (itoa cnt) " ] " (if (> cnt 1) "s" "") "are saved and closed")) (princ "\nThere's no dwg for closing.") ) (princ) ) (defun @CloseAllButActive (TrueOrFalse / cnt) (setq cnt 0) (vlax-for Item (vla-get-Documents (vlax-get-acad-object)) (if (= (vla-get-Active Item) :vlax-False) (progn (vla-close Item TrueOrFalse) (setq cnt (1+ cnt)) ) ) ) cnt ) ;; Popup - Lee Mac ;; A wrapper for the WSH popup method to display a message box prompting the user. ;; ttl - [str] Text to be displayed in the pop-up title bar ;; msg - [str] Text content of the message box ;; bit - [int] Bit-coded integer indicating icon & button appearance ;; Returns: [int] Integer indicating the button pressed to exit (defun LM:popup ( ttl msg bit / wsh rtn ) (if (setq wsh (vlax-create-object "wscript.shell")) (progn (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit))) (vlax-release-object wsh) (if (not (vl-catch-all-error-p rtn)) rtn) ) ) ) (c:CNC)
    2 points
  46. Just to get you going a bit, this should return the entity name of the largest area polyline in your drawing. Command LineArea (defun PolyLineArea ( MyPolyLineEntName / MyArea) (setq MyPolyLine (vlax-ename->vla-object MyPolyLineEntName)) (setq MyArea (vla-get-Area MyPolyLine) ) MyArea ) ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-the-largest-number-in-a-list-of-numbers/td-p/816742 (defun maxinlist (x / next highest) (setq next 0) (setq highest (nth 0 x)) ; Assumes that the first item in the list is the highest. Then iterates through every number in the list (while (< next (1- (length x))) (setq highest (max highest (nth (1+ next) x))) (setq next (1+ next)) ) highest ) ) (defun c:LineArea ( / MyPolyLineEntName Acount AreaList) (vl-load-com) ;;Load VL (setq AreaList (list)) ;;Blank List (setq Acount 0) ;; Set a counter to 0 (setq ss (ssget "_A")) ;;select set, all visible objexts, change A to X for all objects (while (< acount (sslength ss)) ;;Loop through selection Set, ss (setq MyPolyLineEntName (ssname ss Acount)) ;;nth entity in ss name (setq AreaList (append AreaList (list (PolyLineArea MyPolyLineEntName)) )) ;;get object area from PolyLineArea function above (setq Acount (+ Acount 1)) ;;increase counter ) (setq largestEntity (ssname ss (vl-position (maxinlist AreaList) AreaList) )) ;; the perimeter entity name using maxinlist function above ) and I reckon if you look to MHUPPs above that will let you offset the perimeter and remove that from the selection set list, , then you can offset all that is left in the other direction, add something to save and close the file and job done? Will come back to look at this tomorrow
    2 points
  47. To tell the machine what you want to do, have to think more step by step. You may have questions such as: Q1. Does 1 dwg contain only 1 part? Q2. Doesn't one dwg contain objects that are not parts and have nothing to do with parts? If you YES these 2 questions, you can add all polylines to the selection set with (ssget "X" '((0 . "LWPOLYLINE"))) and then mark the polyline with the largest area as the outside. Q3. Are there any isolated objects like donuts in your parts? this case make some headache.. If you don't have donuts, you just have to offset them all to the small side. But with donuts, a problem arises. It may be better to auto-assign the isolate using a hatch. This is just example, I recently used command HATCH to group objects into a selection set. (BMP3) https://www.cadtutor.net/forum/topic/75162-bmp-file-to-polyline-mosaic/ And when offsetting a closed polyline, you need to know whether the polyline is drawn clockwise or counterclockwise to determine the direction of the outer or inner offset. This is the correct way. but I think below is more understandable, 1. create inside & outside both polylines 2. determine the outside if the length is long & the inside if the length is short 3. and delete what you don't need. This Link is example I wrote this way. Lisp that repeatedly offsets the inside of a shape until it is impossible to offset it. https://www.cadtutor.net/forum/topic/74957-inside-offset-multiple/ This allows you to use the offset in any direction without considering the order of the nodes. It's not a good way because to create something you don't need and then delete it. But for a beginner like me, this was more intuitive. And, It is generally impossible to use Lisp in multiple drawings, so i recommend using it with a script. However, if you have difficulties with the script, there is a simple way to register Lisp in the startup set, make Lisp run automatically when opened, then open all DWGs manually, then save and close at once. with CLOSEALL command
    2 points
  48. Maybe this. ; Pline segment with angle (defun c:plseg( / oldsnap pick plobj pick2 param segemnt co-ord pt1 pt2 ang) (setq plent (entsel "\nSelect Pline or line ")) (setq oldsnap (getvar 'osmode)) (setvar "osmode" 0) (cond ((= (cdr (assoc 0 (entget (car plent)))) "LWPOLYLINE") (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)))) pt1 (nth segment co-ord) pt2 (nth (+ segment 1) co-ord)) ) ((= (cdr (assoc 0 (entget (car plent)))) "LINE") (setq lObj (vlax-ename->vla-object (car plent)) pt1 (vlax-curve-getstartPoint lobj) pt2 (vlax-curve-getEndPoint lobj)) ) ((alert "incorrect object selected Pline or line")) ) (setq ang (angle pt1 pt2)) (alert (strcat "angle is " (rtos (/ (* ang 180.0) pi) 2 2) )) (setvar 'osmode oldsnap) (princ) )
    2 points
  49. This will make a list of the attributes in a block. You can use this list in the Lee-mac code. (setq obj (vlax-ename->vla-object (car (entsel "Pick blk")))) (setq atts (vlax-invoke obj 'Getattributes)) (setq lst '()) (foreach att atts (setq lst (cons (vla-get-textstring att) lst)) )
    2 points
×
×
  • Create New...