Leaderboard

Dotted pairs worked great. Thank you! Here is the completed LISP. ;Created by Nick Van Laar for use @ STREAMLINE IRRIGATION ;Calculates the friction loss and velocity of water through common sizes of PVC for the distance of user selected lines/polylines/arcs/etc. (defun C:Hazen () (setq ss (ssget)) (if ss (progn (setq pipeDiameter (getreal "\nEnter pipe diameter (in inches): ")) (setq flowRateGPM (getreal "\nEnter flow rate (GPM): ")) (setq pipeLength 0.0) (setq pipelist '((1 . 1.189) (1.5 . 1.72) (2 . 2.22) (3 . 3.23) (4 . 4.267) (5 . 5.27) (6 . 6.282) (8 . 7.82) (10 . 9.78) (12 . 11.73) (15 . 14.66) (18 . 17.92) (21 . 21.13) (24 . 23.8) (27 . 26.8))) (setq n (1- (sslength ss))) ;Adapted TLEN.LSP - (C) Tee Square Graphics (while (>= n 0) (setq ent (entget (setq itm (ssname ss n))) obj (cdr (assoc 0 ent)) l (cond ((= obj "LINE") (distance (cdr (assoc 10 ent))(cdr (assoc 11 ent)))) ((= obj "ARC") (* (cdr (assoc 40 ent)) (if (minusp (setq l (- (cdr (assoc 51 ent)) (cdr (assoc 50 ent))))) (+ pi pi l) l))) ((or (= obj "CIRCLE")(= obj "SPLINE")(= obj "POLYLINE") (= obj "LWPOLYLINE")(= obj "ELLIPSE")) (command "_.area" "_o" itm) (getvar "perimeter")) (T 0)) pipeLength (+ pipeLength l) n (1- n))) ;Get pipe ID (defun get-value (key 1st) (cdr (assoc key 1st))) (setq pipeID (get-value pipeDiameter pipelist)) ;Get roughnessFactor (setq rCoef nil) (IF (>= pipeDiameter 8) (setq rCoef 150) (setq rCoef 140) ) ; Calculate pressure loss using Hazen-Williams equation (setq pressureLoss (/ (* (* 4.55 (expt (/ flowRateGPM rCoef) 1.852)) (/ pipeLength 12)) (expt pipeID 4.87)) ) ; Calculate Velocity (setq velocity (/ (* 0.408 flowRateGPM) (expt pipeID 2)) ) (alert (strcat "Pressure loss (psi): " (rtos pressureLoss 2 3) " Velocity (fps): " (rtos velocity 2 2))) ) (alert "No valid pipe selected.") )

(defun c:ml2polyline () (setq pline (car (entsel "\nSelect a polyline: "))) (if (not (eq (cdr (assoc 0 (entget pline))) "POLYLINE")) (progn (princ "\nSelected object is not a polyline.") (princ) ) (progn (setq plineStart (cdr (assoc 10 (entget pline)))) (setq plineEnd (cdr (assoc 11 (entget pline)))) (if (not (and plineStart plineEnd)) (progn (princ "\nError getting polyline coordinates.") (princ) ) (progn (setq midPoint (polar plineStart (angle plineStart plineEnd) (/ (distance plineStart plineEnd) 2))) (command "_.MLEADER" plineStart "") (command ".leader" plineEnd "") (setq ml (entlast)) (command ".leader" plineStart "") (setq ml2 (entlast)) (command ".leader" plineEnd "") (setq ml3 (entlast)) (setq angle (angle plineStart plineEnd)) (command "_.rotate" ml "" plineStart angle) (command "_.rotate" ml2 "" plineStart angle) (command "_.rotate" ml3 "" plineEnd (+ angle pi)) (princ "\nMultileader added successfully.") ) ) ) ) (princ) ) ive have come up this much, but it doesnt work, when asked to select a polyline, i do so but then autocad says i have not selected a polyline ?! where am i going wrong here does anyone have an idea?

You could use a list of dotted pairs. Make a list such as (setq pipelst '((1 . 1.189)(1.5 . 1.72)(2 . 2.22) .......) I am not on my computer so I can't properly write code. You then ask user for nominal size and using autolisp assoc command get the actual diameter with the cdr command. I know this is not very specific but look up dotted pairs , assoc and cdr commands.

I've used the ALIASEDIT (Express Tool) command since they added it years ago as the dialog box is quick & simple. I haven't done an isometric drawing since taking a CAD course in 1982 but no aliases have been added for your ISO tools commands if they're not listed in the pgp file. If multiple aliases are listed in the pgp file it defaults to the last one so if you add one add it to the bottom of the pgp file, the ALIASEDIT (Express Tool) does that automatically.

Your welcome to use multi getvals it will make a dcl on the fly for your input of values. If make mistake can correct before hit Ok.Multi GETVALS.lsp (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq lst (list "Please enter values " "Enter client name: " 20 19 " " "Enter location: " 20 19 " " "Enter crop: " 20 19 " " "Enter date code: " 20 19 " " "Enter acres: " 20 19 " " "Enter plant count: " 20 19 " " "Enter application rate: " 20 19 " ")) (setq ans (AH:getvalsm lst)) ; ans is a list of the values you can set to a vataible or use (nth x ans) in your write line ps start at x=0

It is better to use the getkword function. There are many ways to accomplish this task. The simplest version: (initget 1 "Yes No") (setq ans (getkword "\nYes or No? :")) But if you wanted a default: (initget "Yes No") (setq ans (getkword "\nYes or No? <Yes> :")) (and (not ans) (setq ans "Yes")) But this can be made more elaborate in many ways.... You can use a WHILE loop to filter incorrect entries: (while (progn (setq ans (cond ((getint "\nSpecify Number [1/2/3] <3>: ")) (3))) (if (not (vl-position ans '(1 2 3))) (princ "\nIncorrect Selection!")))) Or, you could use a GLOBAL variable to hold the default value: (or *ans* (setq *ans* "A")) (initget "A B C") (or (not (setq ans (getkword (strcat "\nSelect a Letter [A/B/C] <" *ans* ">: ")))) (setq *ans* ans)) Just providing a few options - there are loads of ways to do this Lee

(defun ketthuc () (setvar "cmdecho" luuecho) (setq *error* luu luu nil luuecho nil );setq (princ) ) ;********************************************************************* (defun modau () (setq luu *error luuecho (getvar "cmdecho") *error (ketthuc) ) ) ;********************************************************************* (defun xulytext (text / kytu ma sokt luusokt lui ) (setq kytu (substr text (strlen text)) ma (ascii kytu) sokt (read kytu) lui 1 ) (if (numberp sokt) (progn (setq luusokt (1+ sokt)) (if (and (numberp sokt) (> (strlen text) 1) ) (progn (setq kytu (substr text (1- (strlen text))) sokt (read kytu) ) (if (numberp sokt) (setq luusokt (1+ sokt) lui 2 ) ) );progn ) (if (= luusokt 100) (setq luusokt 0)) (setq kytu (rtos luusokt 2 0) text (strcat (substr text 1 (- (strlen text) lui)) kytu) ) );progn (if (or (= kytu "z") (= kytu "Z") ) (setq text (strcat text "0") textxl "0" ) (setq ma (1+ ma) text (strcat (substr text 1 (1- (strlen text))) (chr ma)) ) );if );if ) ;********************************************************************* (defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle) ;Neu doi tuong la text thi tiep tuc (setq doituong (entget tendoituong) kieu (cdr (assoc 0 doituong)) canle (cdr (assoc 72 doituong)) ) (if (or (= kieu "TEXT") (= kieu "MTEXT") ) (progn (setq textxl (xulytext textxl) text (cons 1 textxl) vitri10 (cdr (assoc 10 doituong)) vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech))) vitri10 (cons 10 vitri10) vitri11 (cdr (assoc 11 doituong)) vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech))) vitri11 (cons 11 vitri11) dem 0 dsach nil ) (foreach tam doituong (cond ((= (car tam) 1) (setq dsach (append dsach (list text)))) ((= (car tam) 10) (setq dsach (append dsach (list vitri10)))) ((= (car tam) 11) (setq dsach (append dsach (list vitri11)))) ((setq dsach (append dsach (list tam)))) ) ) (entmake dsach) );progn );if ); ;********************************************************************* ;sao doi tuong cu sang vi tri moi (defun copy_dt (tendoituong ) (command "copy" tendoituong "" goc toi ) );defun ;********************************************************************* (defun c:CT ( / cumdt dodai thoat dem ten doituong textxl dem goc toi) ; Khoi dau cua chuong trinh (princ "\nCopy thong minh...\n") (setq luuecho (getvar "cmdecho") luu *error* *error* ketthuc cumdt (ssget) dodai (sslength cumdt) goc (getpoint "\nDiem goc copy:") thoat nil dem 0 textxl nil ); (setvar "cmdecho" 0) ; Loc ra duoc ong text de xu ly (while (and (= thoat nil) (< dem dodai) ) (setq ten (ssname cumdt dem) dem (1+ dem) doituong (entget ten) kieu (cdr (assoc 0 doituong)) ) (if (or (= kieu "TEXT") (= kieu "MTEXT") ) (setq thoat T textxl (cdr (assoc 1 doituong)) ) ) ); (while T (setq toi (getpoint "\nDiem dat doi tuong: " goc) vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc))) dem 0 ) (while (< dem dodai) (setq ten (ssname cumdt dem) dem (1+ dem) doituong (entget ten) kieu (cdr (assoc 0 doituong)) ) (if (or (= kieu "TEXT") (= kieu "MTEXT") ) (doitext ten) (copy_dt ten) );if ) );while (ketthuc) );defun (princ) my lisp is only copy and increase 2 last character but create a new text , can you help me develop this lisp can overwrite the existing text