Leaderboard
Popular Content
Showing content with the highest reputation on 05/23/2023 in all areas
-
Command versioning has been an issue since Action Recorder was added with AutoCAD 2009 https://www.autodesk.com/support/technical/article/caas/sfdcarticles/sfdcarticles/Command-macro-does-not-work-the-same-as-it-did-in-AutoCAD-2008-and-previous-versions.html Command Versioning in AutoCAD https://withoutanet.typepad.com/without_a_net/2009/12/command-versioning-in-autocad.html See also: About Special Control Characters in Command Macros https://help.autodesk.com/view/ACD/2024/ENU/?guid=GUID-DDDB6E26-75E1-4643-8C6A-BEAEBA83A4241 point
-
No worries, I would look seriously at using layers for the type of object.1 point
-
1 point
-
I use a terrific program by Lee Mac. I use command buttons for the different options. Look at Iee-mac.com/steal.html. I think this will do exactly what you want.1 point
-
You can add your text style along with the layer name to the program if you wish. (defun c:Test (/ int sel cad ent get 1st 2nd sum num ins txt lst dig pos ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect rectangle with four corners to count texts within : ") (setq int -1 sel (ssget '((0 . "LWPOLYLINE") (90 . 4)))) (setq cad (vlax-get-acad-object)) (or (vla-zoomExtents cad) t) (while (setq int (1+ int) ent (ssname sel int)) (and (setq get (entget ent) 1st (assoc 10 get) 2nd (cdr (assoc 10 (cdr (member (assoc 10 (cdr (member 1st get))) get)))) ) (setq sum 0.0 num -1 ins (ssget "_W" (setq 1st (cdr 1st)) 2nd '((0 . "TEXT")))) (while (setq num (1+ num) txt (ssname ins num)) (and (setq lst (entget txt)) (numberp (setq dig (read (cdr (assoc 1 lst))))) (setq sum (+ sum dig)) ) ) ) (entmake (list '(0 . "TEXT") (cons 10 (setq pos (mapcar '(lambda (j k) (/ (+ j k) 2.0)) 1st 2nd))) (cons 1 (if (> sum 0.0) (rtos sum 2 2) "0.00")) '(40 . 0.36) (cons 11 pos) '(71 . 0) '(72 . 1) '(73 . 2))) ) (vla-ZoomPrevious cad) ) (princ) ) (vl-load-com)1 point
-
This should work Command SNR (for Sum Numbers in Rectangles) (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;; LW Vertices - Lee Mac ;; Returns a list of lists in which each sublist describes ;; the position, starting width, ending width and bulge of the ;; vertex of a supplied LWPolyline (defun LM:LWVertices ( e ) (if (setq e (member (assoc 10 e) e)) (cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e) ) (LM:LWVertices (cdr e)) ) ) ) (defun getVertices ( pline / verts vert res) (setq verts (LM:LWVertices (entget pline) )) (setq res (list)) (foreach vert verts (setq p (cdr (assoc 10 vert))) (setq res (append res (list p))) ) res ) ;; returns (list min-x min-y max-x max-y) (defun getWindow (pointlist / i min-x min-y max-x max-y) (setq i 0) (foreach point pointlist (if (= i 0) (progn ;; first point (setq min-x (nth 0 point)) (setq min-y (nth 1 point)) (setq max-x (nth 0 point)) (setq max-y (nth 1 point)) progn) (progn (if (< (nth 0 point) min-x)(setq min-x (nth 0 point))) (if (< (nth 1 point) min-y)(setq min-y (nth 1 point))) (if (> (nth 0 point) max-x)(setq max-x (nth 0 point))) (if (> (nth 1 point) max-y)(setq max-y (nth 1 point))) progn) ) (setq i (+ i 1)) ) (list min-x min-y max-x max-y) ) ;; Sum Numbers in Rectangles (defun c:snr ( / pline verts window ss ss0 sum numb th i j) (setq th 1.0) ;; default text height (setq j 0) (princ "\nSelect the rectangles: ") (setq ss0 (ssget (list (cons 0 "*POLYLINE") ) )) (princ (sslength ss0) ) (repeat (sslength ss0) ;; (setq pline (entsel "\nSelect Rectangle: ")) (setq pline (ssname ss0 j)) (if pline (progn (setq sum 0.0) (setq verts (getVertices pline)) (setq window (getWindow verts)) ;; get all texts inside that window (setq ss (ssget "w" (list (nth 0 window) (nth 1 window)) (list (nth 2 window) (nth 3 window)) (list (cons 0 "TEXT") ))) (setq i 0) (if ss (progn (repeat (sslength ss) (princ "\n") (setq numb (atof (cdr (assoc 1 (entget (ssname ss i)))))) ;; sum (setq sum (+ sum numb)) (princ numb) (setq i (+ i 1)) ) ;; text height (setq th (cdr (assoc 40 (entget (ssname ss 0))))) (drawText (list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2)) th (rtos sum 2 2) ) ) ;; no text found in rectangle (drawText (list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2)) th "0.0" ) ) (princ "\n\n") (princ sum) )) (setq j (+ j 1)) ) (princ) )1 point
-
1 point
-
Alan thx for the code... using SSD, the linetype is drawn as continuous. I changed "CES.lin" to nil first but linetype didn't get drawn as HIDDEN2, only continuous. (layer popdown indicates that HIDDEN2 was intended). FYI, PSD function is fine. TIA, Steve1 point
-
What do you need to change to get your lisp to work with metric units (i.e. width 0.5m instead of 24 inches etc) and not imperial alanjt? I tried changing the lines (setq D2 (/ D 12)) to just (setq D2 (D) althoguh this obviously didn't work.1 point
-
The second code PSD should give you what you want. ;original coding taken from Pipe.lsp, created by Tim Wilson (9.11.95, revised 6.22.97) ;modified by alan thompson (11.18.08) for use at Capital Engineering and Surveying, Inc. ; 1. created 2 routines (SSD & PSD) ; a. SSD will create an existing (Survey) storm pipe on the "V-STRM-PIPE" layer with a hidden2 linetype. ; (if layer and/or linetype do not exist, they are created/loaded) ; b. PSD will create a proposed (Engineering) storm pipe on the "C-STRM-PIPE" layer with a continuous linetype. ; (if layer and/or linetype do not exist, they are created/loaded) ; 2. added error handler ; 3. removed unnecessary code, formatted and cleaned up code ; 4. localized subroutines ;thank you Tim Wilson for the borrowed coding. ;;Survey STORM (defun C:SSD (/ *error* DTR PNT1 PNT2 D D2 A ET HD L1 L2 L3 L4 OTM c_layer my_linfile my_layer my_color my_ltype ) (vl-load-com) ;;;;;SUB ROUTINES;;;;; (defun *error* (msg) msg (setvar "clayer" c_layer) (setvar "orthomode" OTM) );defun (defun DTR (a) (* PI (/ A 180.0)) ) ;;;;;MAIN ROUTINE;;;;; (setq my_linfile "CES.lin") ;linetype file to reference (if using default acad.lin, set as: nil) (setq my_layer "V-STRM-PIPE") ;layer to use (setq my_color 172) ;color to use (setq my_ltype "hidden2") ;linetype to use (setq c_layer (getvar "clayer")) (setq OTM (getvar "orthomode")) (setvar "cmdecho" 0) (setvar "orthomode" 0) (if (and (not (= my_linfile nil)) (findfile my_linfile) (not (tblsearch "ltype" my_ltype)) );and (vl-cmdf "_.linetype" "_l" my_ltype my_linfile "") );if (if (and (setq PNT1 (getpoint "\nPick Start of Pipe: ")) (setq PNT2 (getpoint pnt1 "\nPick End of Pipe: ")) (setq D (getdist "\nEnter Pipe Width: ")) ;In INCHES IE 24", 30", 42" SO ON );and (progn (if (tblsearch "layer" my_layer) (vl-cmdf "_.layer" "_t" my_layer "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "") (vl-cmdf "_.layer" "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "") );if (setq D2 (/ D 12)) (SETQ D D2) (while Pnt2 (setq HD (/ D 2)) (setq A (angle PNT1 PNT2)) (setq ET (entlast)) (setq L1 (polar pnt1 (- a (dtr 90)) HD)) (setq L2 (polar pnt2 (- a (dtr 90)) HD)) (setq L3 (polar pnt1 (+ a (dtr 90)) HD)) (setq L4 (polar pnt2 (+ a (dtr 90)) HD)) (vl-cmdf "_.line" "_non" L1 "_non" L2 "" "_.line" "_non" L3 "_non" L4 "") (setq PNT1 PNT2) (setq PNT2 (getpoint PNT1 "\nNext Point: <Return or Enter to Quit> ")) );while (setvar "clayer" c_layer) (setvar "orthomode" OTM) );progn );if (princ) );defun ;;Proposed STORM (defun C:PSD (/ *error DTR PNT1 PNT2 D D2 A ET HD L1 L2 L3 L4 OTM c_layer my_linfile my_layer my_color my_ltype my_ltype_mid ) (vl-load-com) ;;;;;SUB ROUTINES;;;;; (defun *error* (msg) msg (setvar "clayer" c_layer) (setvar "orthomode" OTM) );defun (defun DTR (a) (* PI (/ A 180.0)) ) ;;;;;MAIN ROUTINE;;;;; (setq my_linfile nil) ;linetype file to reference (if using default acad.lin, set as: nil) (setq my_layer "C-STRM-PIPE") ;layer to use (setq my_color 2) ;color to use (setq my_ltype "continuous") ;linetype to use for exterior lines (setq my_ltype_mid "hidden") ;linetype to use for interior line (pline with width of pipe) (setq c_layer (getvar "clayer")) (setq OTM (getvar "orthomode")) (setvar "cmdecho" 0) (setvar "orthomode" 0) ;load my_ltype (if (and (not (= my_linfile nil)) (findfile my_linfile) (not (tblsearch "ltype" my_ltype)) );and (vl-cmdf "_.linetype" "_l" my_ltype my_linfile "") );if ;load my_ltype_mid (if (and (not (= my_linfile nil)) (findfile my_linfile) (not (tblsearch "ltype" my_ltype_mid)) );and (vl-cmdf "_.linetype" "_l" my_ltype_mid my_linfile "") );if (if (and (setq PNT1 (getpoint "\nPick Start of Pipe: ")) (setq PNT2 (getpoint PNT1 "\nPick End of Pipe: ")) (setq D (getdist "\nEnter Pipe Width: ")) ;In INCHES IE 24", 30", 42" SO ON );and (progn (if (tblsearch "layer" my_layer) (vl-cmdf "_.layer" "_t" my_layer "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "") (vl-cmdf "_.layer" "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "") );if (setq D2 (/ D 12)) (setq D D2) (while Pnt2 (setq HD (/ D 2)) (setq A (angle PNT1 PNT2)) (vl-cmdf "_.pline" "non" PNT1 "non" PNT2 "") (setq ET (entlast)) (setq L1 (polar pnt1 (- a (dtr 90)) HD)) (setq L2 (polar pnt2 (- a (dtr 90)) HD)) (setq L3 (polar pnt1 (+ a (dtr 90)) HD)) (setq L4 (polar pnt2 (+ a (dtr 90)) HD)) (vl-cmdf "_.line" "non" L1 "non" L2 "" "line" "non" L3 "non" L4 "") (vl-cmdf "_.change" ET "" "_p" "_lt" my_ltype_mid "") ;change linetype to suit (vl-cmdf "_.pedit" ET "_w" D "") (setq PNT1 PNT2) (setq PNT2 (getpoint PNT1 "\nNext Point: <Return or Enter to Quit>: ")) );while );progn );if (setvar "orthomode" OTM) (setvar "clayer" c_layer) (princ) );defun1 point
-
I don´t know much about lisp... the demonstration is below... I made this quick approach... Once I made a lisp for quick trimming an intersection using polar points... so I thought I could do soemthing similar today.. but I definitely need to read more about it... anyway.. it is a start for someone else to finish it... type storm1 and pick 2 points... it doesn´t work completely right now.. but surely someone will fix it. ;will draw a single line composed of three lines, width is equal to 1 ;base=1" ;it may contain extra code for any pipe size (defun C:storm1 () (setq om (getvar "osmode")) (setq or (getvar "orthomode")) (setvar "cmdecho" 0) (setq p1 (getpoint "\nPick first point.. ")) (setq p2 (getpoint "\nPick second point.. ")) (setvar "osmode" 0) (setvar "orthomode" 0) (command "ucs" pt1 pt2 "") (setq p3 (polar p1 90 0.5)) (setq p5 (polar p1 270 0.5)) (setq p4 (polar p2 90 0.5)) (setq p6 (polar p2 270 0.5)) (command "line" p3 p4 "") (command "line" p5 p6 "") (command "_.-linetype" "load" "hidden2" (strcat "C:/archivos de programa/AutoCAD 2009/UserDataCache/Support/acad.lin") "" "") (command "_.-linetype" "set" "hidden2" "") (command "pline" p1 "W" "1" "1" p2 "") (command "_.-linetype" "set" "bylayer" "") (command "ucs" "w") (setvar "osmode" om) (setvar "orthomode" or) (setvar "cmdecho" 1) (princ) )1 point
-
My suggestion. (setvar "osmode" 545) (setq setang (getangle (getpoint "\nPick 1st point for angle ")(getpoint "\nPick 2nd point "))) or better (setq pt1 (getpoint "\nPick 1st point for angle ") pt2 (getpoint pt1 "\nPick 2nd point ")) (setq setang (getangle pt1 pt2))-1 points