Jump to content

Search the Community

Showing results for tags 'autolisp'.

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


Forums

  • CADTutor
    • News, Announcements & FAQ
    • Feedback
  • AutoCAD
    • AutoCAD Beginners' Area
    • AutoCAD 2D Drafting, Object Properties & Interface
    • AutoCAD Drawing Management & Output
    • AutoCAD 3D Modelling & Rendering
    • AutoCAD Vertical Products
    • AutoCAD LT
    • CAD Management
    • AutoCAD Bugs, Error Messages & Quirks
    • AutoCAD General
    • AutoCAD Blogs
  • AutoCAD Customization
    • The CUI, Hatches, Linetypes, Scripts & Macros
    • AutoLISP, Visual LISP & DCL
    • .NET, ObjectARX & VBA
    • Application Beta Testing
    • Application Archive
  • Other Autodesk Products
    • Autodesk 3ds Max
    • Autodesk Revit
    • Autodesk Inventor
    • Autodesk Software General
  • Other CAD Products
    • BricsCAD
    • SketchUp
    • Rhino
    • SolidWorks
    • MicroStation
    • Design Software
    • Catch All
  • Resources
    • Tutorials & Tips'n'Tricks
    • AutoCAD Museum
    • Blocks, Images, Models & Materials
    • Useful Links
  • Community
    • Introduce Yourself
    • Showcase
    • Work In Progress
    • Jobs & Training
    • Chat
    • Competitions

Categories

  • Programs and Scripts
  • 2D AutoCAD Blocks
  • 3D AutoCAD Blocks
  • Images
    • Backgrounds

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

  1. Hello, I would apprecite some reactions on the following tools that I made. Reading about Clojure I came across functionality that is not standard available in AutoLisp. After some thinking I programmed it myself. First 2 functions which do what they are supposed to do: (defun even? (n) (and (= (type n) 'INT) (= (rem n 2) 0))) (defun odd? (n) (and (= (type n) 'INT) (/= (rem n 2) 0))) The questionmark in the functionname seems appropriate. So what to do when you want to filter a list of integers against one of these functions? I constructed the following: (defun filter (f l / a) (foreach i l (if (apply f (list i)) (setq a (append a (list i))))) a) To get you started use the following two commands: (defun c:etest () (filter 'even? (list -5 -4 -3 -2 -1 0 1 2 3 4 5))) (defun c:otest () (filter 'odd? (list -5 -4 -3 -2 -1 0 1 2 3 4 5))) Although short already I wonder if the filter routine could be made more elegant/more logical. One can extend the library with all kinds of name? functions, provided that return T or nil on every call. The questionmark and the name 'filter' are used for logic readability. Try to make a functon that returns T if a value is of type 'STR, otherwise nil. Next use it with the filter function. It's fun and would like to see the variations that you come up with. Regards, André
  2. hello all;I'm using the code bellow, but i need to click on almost 2000 road cross sections one by one, indeed that is time consuming. it would be more general if the code can select all green lines at ones and then the red lines. mean that, if there be 2000 road cross sections for example; the code can select all cross sections and report a cut and fill file separately for each section (the same as AreaLabelV1-9.lsp of Mr.Lee Mac does)appreciate if anyone can help metnx ;;; Cut & Fill by ymg ; ;;; ; (defun c:cf (/ ** *acdoc* a are b bnd c cutcol d dir dl1 dl2 e fillcol hcol intl len1 len2 p p0 p1 p2 pm pol1 pol2 sp1 sp2 spe ss1 ss2 totcut totfill txt txtlayer varl) (vl-load-com) (defun *error* (msg) (mapcar 'eval varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (and *acdoc* (vla-endundomark *acdoc*)) (princ) ) (setq varl '("OSMODE" "CMDECHO" "DIMZIN" "PEDITACCEPT") varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl) ) (or *acdoc* (setq *acdoc* (vla-get-activedocument (vlax-get-acad-object)))) (vla-startundomark *acdoc*) (setvar 'CMDECHO 0) (setvar 'DIMZIN 0) (setvar 'OSMODE 0) (setq cutcol 1 fillcol 3 ; Cut is Red, Fill is Green ; totcut 0 totfill 0 ; Total Cut and Total Fill ; txtlayer "Text" ; Name of Layer for Cut and Fill Values ; ) (while (not (setq ** (princ "\nSelect Reference Polyline:") ss1 (ssget "_+.:L:S" '((0 . "LWPOLYLINE"))) ) ) (princ "\nYou Must Select a Polyline:") ) (while (not (setq ** (princ "\nSelect Proposed Polyline:") ss2 (ssget "_+.:L:S" '((0 . "LWPOLYLINE"))) ) ) (princ "\nYou Must Select a Polyline:") ) (setq pol1 (ssname ss1 0) len1 (vlax-curve-getDistAtParam pol1 (vlax-curve-getEndParam pol1)) pol2 (ssname ss2 0) len2 (vlax-curve-getDistAtParam pol2 (vlax-curve-getEndParam pol2)) sp1 (vlax-curve-getstartpoint pol1) spe (vlax-curve-getendpoint pol1) sp2 (if (vlax-curve-isClosed pol2) (setq lst2 (listpol pol2) disl (mapcar '(lambda (a) (distance sp1 a)) lst2) ** (plineorg pol2 (nth (vl-position (apply 'min disl) disl) lst2)) ) (vlax-curve-getstartpoint pol2) ) dir (if (< (/ pi 2) (angle sp1 spe) (/ (* 3 pi) 2)) -1 1) ) ; Getting all the intersections between poly. ; (setq intl (intersections pol1 pol2)) (if (> (length intl) 1) (progn ; Computing distance of intersections on each polyline ; (setq dl1 (mapcar '(lambda (a) (getdistoncurve pol1 a)) intl) dl2 (mapcar '(lambda (a) (getdistoncurve pol2 a)) intl) ) ; If both polyline are closed add first Intersection to end of list ; ; We also add a distance to each distances list ; (if (and (vlax-curve-isClosed pol1) (vlax-curve-isClosed pol2)) (setq dl1 (append dl1 (list (+ (car dl1) len1))) dl2 (append dl2 (list (+ (car dl2) len2))) intl (append intl (list (car intl))) dir (if (iscw_p (listpol pol1)) -1 1) ) ) ; Finding points at mid-distance between intersections on each polyline ; ; Calculating midpoint between mid-distance points to get an internal point; ; Creating a list of all these points plus the intersection points ; (setq pm (mapcar '(lambda (a b c d e) (list (midpoint (setq p1 (getptoncurve pol1 (rem (* (+ a b) 0.5) len1))) (setq p2 (getptoncurve pol2 (rem (* (+ c d) 0.5) len2))) ) p1 p2 e ) ) dl1 (cdr dl1) dl2 (cdr dl2) intl ) ) (foreach i pm (setq p (car i) ; Midpoint between p1 p2 ; p0 (cadddr i) ; Intersection Point ; p1 (cadr i) ; Midpoint of Intersections on Reference Polyline ; p2 (caddr i) ; Midpoint of Intersections on Proposed Polyline ; ) (if (> (abs (onside p2 p0 p1)) 1e-3) ; Not Colinear ; (progn (vl-cmdf "._-BOUNDARY" p "") (setq are (vla-get-area (vlax-ename->vla-object (entlast))) bnd (entlast) ) (if (minusp (* (onside p2 p0 p1) dir)) (setq totfill (+ totfill are) hcol fillcol) (setq totcut (+ totcut are) hcol cutcol) ) (vl-cmdf "._-HATCH" "_CO" hcol "." "_P" "SOLID" "_S" bnd "" "") (entdel bnd) ) ) ) (setq p (cadr (grread nil 13 0)) txt (strcat "{\\C3;Fill: " (rtos totfill 2 2) " m2\\P\\C1;Cut: " (rtos totcut 2 2) " m2}") ) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 txtlayer) (cons 100 "AcDbMText") (cons 10 p) (cons 40 3.0) (cons 1 txt) ) ) (command "_MOVE" (entlast) "" p pause) ) (Alert "Not Enough Intersections To Process !") ) (*error* nil) ) (princ "\nCalculates Cut & Fill Between Two Intersecting Polylines") (princ "\nCF to start...") (defun midpoint (p1 p2) (mapcar '(lambda (a b) (* (+ a b) 0.5)) p1 p2) ) ; onside by ymg ; ; Negative return, point is on left of v1->v2 ; ; Positive return, point is on right of v1->v2 ; ; 0 return, point is smack on the vector. ; ; ; (defun onside (p v1 v2 / x y) (setq x (car p) y (cadr p)) (- (* (- (cadr v1) y) (- (car v2) x)) (* (- (car v1) x) (- (cadr v2) y))) ) ; ; ; Is Polyline Clockwise by LeeMac ; ; ; ; Argument: l, Point List ; ; Returns: t, Polyline is ClockWise ; ; nil, Polyline is CounterClockWise ; ; ; (defun iscw_p (l) (if (equal (car l) (last l) 1e-8) (setq l (cdr l))) (minusp (apply '+ (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) ) l (cons (last l) l) ) ) ) ) ;; ; ;; Return list of intersection(s) between two VLA-Object or two ENAME ; ;; obj1 - first VLA-Object ; ;; obj2 - second VLA-Object ; ;; mode - intersection mode (acExtendNone acExtendThisEntity ; ;; acExtendOtherEntity acExtendBoth) ; ;; Requires triplet ; ;; ; (defun Intersections (obj1 obj2) (or (= (type obj1) 'VLA-OBJECT) (setq obj1 (vlax-ename->vla-object obj1))) (or (= (type obj2) 'VLA-OBJECT) (setq obj2 (vlax-ename->vla-object obj2))) (triplet (vlax-invoke obj1 'intersectwith obj2 acExtendNone)) ) ;; ; ;; triplet, Separates a list into triplets of items. ; ;; ; (defun triplet (l) (if l (cons (list (car l) (cadr l) (caddr l))(triplet (cdddr l)))) ) (defun getdistoncurve (e p) (vlax-curve-getDistatParam e (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p) ) ) ) (defun getptoncurve (e d) (vlax-curve-getpointatparam e (vlax-curve-getparamatdist e d)) ) ;; ; ;; listpol by ymg (Simplified a Routine by Gile Chanteau ; ;; ; ;; Parameter: en, Entity Name or Object Name of Any Type of Polyline ; ;; ; ;; Returns: List of Points in Current UCS ; ;; ; ;; Notes: On Closed Polyline the Last Vertex is Same as First) ; ;; ; (defun listpol (en / i l) (repeat (setq i (fix (1+ (vlax-curve-getEndParam en)))) (setq l (cons (trans (vlax-curve-getPointAtParam en (setq i (1- i))) 0 1) l)) ) ) ;; plineorg by (gile) (Modified into a function by ymg) ; ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ ; ;; change-polyline-start-point/td-p/2154331 ; ;; ; ;; Function to modify origin of a closed polyline ; ;; ; ;; Arguments: ; ;; en : Ename or VLA-Object of a Closed Polyline. ; ;; pt : Point ; ;; ; ;; Returns: Point of Origin if successful, else nil. ; ;; ; (defun plineorg (en pt / blst d1 d2 d3 n norm obj pa plst) (if (= (type en) 'ENAME) (setq obj (vlax-ename->vla-object en)) (setq obj en en (vlax-vla-object->ename obj)) ) ;; bulgratio by (gile) ; ;; Returns a bulge which is proportional to a reference ; ;; Arguments : ; ;; b : the reference bulge ; ;; k : the ratio (between angles or arcs length) ; (defun bulgratio (b k / a) (setq a (atan b)) (/ (sin (* k a)) (cos (* k a))) ) ;; Sublist by (gile) ; ;; Returns a sublist similar to substr function. ; ;; lst : List from which sublist is to be extracted ; ;; idx : Index of Item at Start of sublist ; ;; len : Length of sublist or nil to return all items. ; (defun sublist (lst n len / rtn) (if (or (not len) (< (- (length lst) n) len)) (setq len (- (length lst) n)) ) (setq n (+ n len)) (repeat len (setq rtn (cons (nth (setq n (1- n)) lst) rtn)) ) ) (if (and (= (vla-get-closed obj) :vlax-true) (= (vla-get-objectname obj) "AcDbPolyline") ) (progn (setq plst (vlax-get obj 'coordinates) norm (vlax-get obj 'normal) pt (vlax-curve-getClosestPointTo en (trans pt 1 0)) pa (vlax-curve-getparamatpoint obj pt) n (/ (length plst) 2) ) (repeat n (setq blst (cons (vla-getbulge obj (setq n (1- n))) blst)) ) (if (= pa (fix pa)) (setq n (fix pa) plst (append (sublist plst (* 2 n) nil) (sublist plst 0 (* 2 n)) ) blst (append (sublist blst n nil) (sublist blst 0 n)) ) (setq n (1+ (fix pa)) d3 (vlax-curve-getdistatparam en n) d2 (- d3 (vlax-curve-getdistatpoint en pt)) d3 (- d3 (vlax-curve-getdistatparam en (1- n))) d1 (- d3 d2) pt (trans pt 0 (vlax-get obj 'normal)) plst (append (list (car pt) (cadr pt)) (sublist plst (* 2 n) nil) (sublist plst 0 (* 2 n)) ) blst (append (list (bulgratio (nth (1- n) blst) (/ d2 d3))) (sublist blst n nil) (sublist blst 0 (1- n)) (list (bulgratio (nth (1- n) blst) (/ d1 d3))) ) ) ) (vlax-put obj 'coordinates plst) (repeat (setq n (length blst)) (vla-setbulge obj (setq n (1- n)) (nth n blst)) ) (trans pt 0 1) ) nil ) )
  3. So I've been at this Lisp Routine for a little while now. Done a lot of searching and researching. I'm almost at the finish line and I need some help with the last few steps. Or at least, the next to last step. So the ultimate goal here is to use our column grid to generate an indicator at intersections. Grid is created more or less by hand so it will always vary. I decided to use the method of placing blocks with attributes at selected column lines' intersections. I've taken care of selection issues of DTEXT vs MTEXT and assigning LINE objects with said TEXT objects. I've whittled down what I would call the big issues except for one. My final result has been a list of "pairs" like this example: (((-2376.0 -504.001 0.0) L) ((-2376.0 -504.001 0.0) ((-2016.0 -504.001 0.0) L) ((-2016.0 -504.001 0.0) 7.1)...) The first part of each item is a point list followed by the corresponding text/string to be used for the block attributes. Problem is I need to combine the items with the same point so that each item will be as follows (((-2376.0 -504.001 0.0) 8 L) ((-2016.0 -504.001 0.0) 7.1 L)...). Now I believe I can workout the order in which they are listed to suit my purposes, but I'm having trouble just combining the two strings with the same point. After this hurdle, I'll need to insert the block WITH those strings filling in the attributes, but I believe I can figure that part out. I've attached a drawing with a sample grid and the lisp routine I've pieced together so far. Here's the main portion of the code in case that's all someone needs: (defun c:setupint (/ mspc ss_txt ss_lines pntlst grdlst attlst i_pnt i_grd ob_pnt ob_grd pnt1 pnt2 pnt3 ob_strg blk) (setq mspc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (princ "\nSelect Grid Text: ") (setq ss_txt (ssget '((0 . "TEXT,MTEXT")))) (princ "\nSelect Grid Lines: ") (setq ss_lines (ssget '((0 . "LINE")))) (setq pntlst (SF:sortyx (LM:intersectionsinset ss_lines))) (setq grdlst (MT:GrdAcList ss_lines ss_txt)) ) (repeat (setq i_pnt (length pntlst)) (setq ob_pnt (nth (setq i_pnt (1- i_pnt)) pntlst)) (repeat (setq i_grd (length grdlst)) (setq ob_grd (nth (setq i_grd (1- i_grd)) grdlst) pnt1 ob_pnt pnt2 (vlax-curve-getStartPoint (cadr ob_grd)) pnt3 (vlax-curve-getEndPoint (cadr ob_grd)) ob_strg (car ob_grd) ) (if (LM:Collinear-p pnt1 pnt2 pnt3) (setq attlst (cons (list ob_pnt ob_strg) attlst)) ;list of text with corresponding point ) ) ;end repeat grd ) ;end repeat pnt ) (setq blk "setupint") (princ attlst) ;Test Print of list ;;; (foreach itm attlst ;;; (setq p (list (nth 0 (car itm)) (nth 1 (car itm)) (nth 2 (car itm)))) ;;; (princ p) ;;; (vla-insertblock mspc (vlax-3D-point p) blk 1.0 1.0 1.0 0) ;;; ) ) (vl-load-com) (princ) SETUP TEST.dwg setupintV2.lsp
  4. I want to change attribute text in title blocks, calling the block by the block name, not selecting the block, looping thru all the layout tabs. The title block will have the same name on each layout. My titleblock is named TITLEBLOCK30x42, with 2 attributes SHEET-TITLE and SHEET-DESCRIPTION. This thread talks about doing the same thing. None of the small generic code posted in that thread works for me. https://www.cadtutor.net/forum/topic/63734-lisp-code-to-select-block-in-layouts-and-update-attributes/
  5. Hi I work in a company, people come to us with their plot registry, on which are the dimensions (north,east,south,west) and area of their plots. But there are no angles. For example, a plot of 25 * 10 meters with an area (according to the mathematical calculations) should be 250 square meters. But 244.95 is listed on the registry.My question is how do I quickly draw this plot (according to the registry) in AutoCAD? Is there any lisp for this?
  6. Hello guys! New to the forum but have been looking at this forum for help for a few years now and has been very helpful for my auto cad education and career! I have this lisp routine that creates a pline in each side of the original pline to create this stormwater pipe. I've been trying to figure out how I can start the offset from the bottom line instead of the middle pline to no avail. Is there anyone that help me with this? Changing the justification of the dragline could save me hours creating details for work. Thanks a bunch! ; STORMWATER.LSP (defun c:SWPIPE () ;(/ PT PT1 PT2 WID ELAST KTEMP E1 E2 ang1 ang2) (setvar "CMDECHO" 0) (initget 1) (setq PT (getpoint "\nStart point: ")) (command ".PLINE" PT "W" 0 0) (setq PT1 PT PT0 PT) (while (setq PT (getpoint PT "\nNext point: ")) (setq PT2 PT) (command PT) ) (setq ang1 (-(angle pt1 pt2)(/ pi 2)) ang2 (+ ang1 pi)) (command) (SETQ OS (GETVAR "OSMODE")) (setvar "osmode" 0) (initget 4) (setq ELAST (entlast) KTEMP (getdist "\nLine width<0.0>:") WID ktemp ; WID (* (if KTEMP KTEMP 0.0416) (GetVar "LTSCALE"));old UserR1 ; PT1 (reverse (cdr (reverse PT1))) ) (command ".OFFSET" (/ WID 2) (list ELAST PT1) (polar PT1 ang1 0.1)"") (setq E1 (entlast)) (command ".OFFSET"(/ WID 2) (list ELAST PT1) (polar PT1 ang2 0.1) "") (setq E2 (entlast)) (command ".PEDIT" ELAST "W" WID "" ".CHANGE" ELAST"" "P" "LT" "HIDDEN1" "") (redraw E1) (redraw E2) (princ)S (setvar "osmode" 0) ) SWPIPE.LSP
  7. Hi all, I want to select specific block by knowing its name lets say block name "cadtutor block 1" by using (vl-catch-all-apply) method Thanks
  8. marc578

    Draw circles

    Hi, this is my first post. I am trying to draw five circles, one in the centre (x=0, y=0) and the other four, located in each quadrant of circle located in (0,0). I have written the script below but, I does not work. The circles with negative coordinates are drawn on top of the other with positive coordinates. I do not understand, why is this behavior, if you know please let me know. (defun C:he () (setq r 10.0) (command "circle" (list 0 0) r "") (command "circle" (list 5 0) r "") (command "circle" (list -5 0) r "") (command "circle" (list 0 5) r "") (command "circle" (list 0 -5) r "") ) Thanks
  9. Hi guys, I'm new to this forum and new to programming with lisp - please be kind.... The code I am writing will draw a 3dPolyline from a specific point to another point (usually with a lower z coordinate), the polyline will then be converted to a spline, a circle will be drawn at the start of the 3dPolyline and extruded along the spline to form a "curved tube". The intention is to use this as a flexible duct from a "spigot" on an A/C duct to a ceiling diffuser. The 3dPoly has to be perpendicular to the start point and end point for obvious reasons - see intentional misalignment picture. Below a portion of the unfinished code to select the start point, select the endpoint, then it must start drawing the 3dpoly from the start point, get a variable number of user input points (in order to define the initial direction and plane) and general path of the flexible duct. The end point of the 3dpoly is already defined with the initial selection of the "Endpoint on Diffuser" although the 2nd last point has to be mathematically determined considering the plane must be perpendicular to the end point. So - after selecting say 3 or 4 user defined points along the path, I want to be able to press enter, and the code must then calculate the 2nd last point and continue drawing the 3dpoly from the last picked point, to the calculated 2nd last point and then to the endpoint. Generally one has to be mindful that the curve of the tube cannot have a "sharp bend" - smooth curves are ideal for the airflow. The diameter of the tube will also change depending on the specific size requirements. Attached a small drawing and picture to show the intent. The crux of my problem: I cannot figure out how to start the 3dpoly command, make it pick the start of the line, then hand over to the user to continue picking 4 or 5 points, press enter, and then continue drawing the 3dpoly with calculated numbers? Would really appreciate some guidance. Maybe use of cmdactive? I really do not know enough to figure this one out. (defun C:Flex250 () (command "_.layer" "_thaw" "HVAC Flex" "_make" "HVAC Flex" "") (setq Prev_OM (getvar "OSMODE")) (setvar "OSMODE" 8) (setq StartPoint (getpoint "\nEnter Start Point on Duct Spigot : ")) (setq EndPoint (getpoint "\nEnter End Point on Diffuser : ")) (setq Z0 (caddr EndPoint)) (setq Z1 (+ (caddr EndPoint) 50)) (setq Z2 (+ (caddr EndPoint) 150)) (setq pt0 EndPoint) (setq pt1 (list (car EndPoint) (cadr EndPoint) Z1)) (setq pt2 (list (car EndPoint) (cadr EndPoint) Z2)) (SetVar "Elevation" (princ (caddr StartPoint))) (command ".3DPoly" (princ Startpoint) (getpoint "\nNext point : ") pt2 pt1 pt0) ) Then a last question - is there a way to ensure the spline's start and finish points are 100% perpendicular to the planes they connect to? Thank you in advance for your input. Test.dwg
  10. Good Day, I want the attached code to run as QDIM in Autocad , My issue in my code that I choose the location of the dimension line after that the dimension appears. I want to see all the dimensions afterwards choose the location like in QDIM command. Thanks (vl-load-com) (defun C:FH ( / *error* doc oVAR ss i pts ptsx ptsy d d0 filter ) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg))) (foreach e oVAR (setvar (car e) (cdr e))) (vla-endundomark doc) (princ)) ;------------------------------------------------------------------------------------------------------ (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (foreach e '(CMDECHO ORTHOMODE) (setq oVAR (cons (cons e (getvar e)) oVAR))) (setvar 'CMDECHO 0) (setvar 'ORTHOMODE 0) (if (and (princ "\nNeed blocks, ") (setq ss (ssget (list '(0 . "INSERT")))) (< 1 (setq i (sslength ss))) (while (not (minusp (setq i (1- i)))) (setq pts (cons (cdr (assoc 10 (entget (ssname ss i)))) pts))) (setq ptsx (vl-sort pts '(lambda (p q) (< (car p) (car q))))) (setq ptsy (vl-sort pts '(lambda (p q) (< (cadr p) (cadr q))))) (setq d (abs (/ (- (car (last ptsx)) (caar ptsx)) ;xmax-xmin (if (zerop (setq d0 (- (cadr (last ptsy)) (cadar ptsy)))) ;ymax-ymin 0.001 d0)))) (setq pt (getpoint "\nSpecify dimension line location: ")) (or *DimTypeBDA (setq *DimTypeBDA "Aligned")) (not (initget "Horizontal Vertical Aligned")) (setq *DimTypeBDA (cond ((getkword (strcat "\nType of dimension [" (cond ((> d 1000.) (if (= *DimTypeBDA "Vertical") (setq *DimTypeBDA "Horizontal")) "Horizontal") ((< d 0.001) (if (= *DimTypeBDA "Horizontal") (setq *DimTypeBDA "Vertical")) "Vertical") ("Horizontal/Vertical")) "/Aligned] <" *DimTypeBDA ">: "))) (*DimTypeBDA))) (setq pts (if (or (= *DimTypeBDA "Horizontal") (and (= *DimTypeBDA "Aligned") (> (- (car (last ptsx)) (caar ptsx)) (- (cadr (last ptsy)) (cadar ptsy))))) ptsx ptsy)) (setq i 0) ) (repeat (1- (length pts)) (cond ((= *DimTypeBDA "Horizontal") (command "_.DIMLINEAR" "_none" (nth i pts) "_none" (nth (1+ i) pts) "_H" "_none" pt)) ((= *DimTypeBDA "Vertical") (command "_.DIMLINEAR" "_none" (nth i pts) "_none" (nth (1+ i) pts) "_V" "_none" pt)) (T ;Aligned (command "_.DIMALIGNED" "_none" (nth i pts) "_none" (nth (1+ i) pts) "_none" pt))) (setq i (1+ i))) (princ (strcat "\nError: Wrong selection of at least 2 BLOCKS."))) (foreach e oVAR (setvar (car e) (cdr e))) (vla-endundomark doc) (princ) ) FH Final.LSP
  11. Dear Team member, I have more number of BOQ table in Auto Cad. Need to export that table and text to excel in editable format. Can anyone help and share the lisp for export cad text / table in excel. Thanks. Mohan
  12. I work for a glazing company where we do all our glass sizing manually and am looking for a way to do it automatically. I am not very knowledgeable in Lisp. So we have a block we use to put the sizes into. I was wondering if it is possible for a lisp to read the size of a rectangle that has the block inside of it and put dimensions into the specified area. The block also has multiple Visibility's to fit in different places. There is also multiple visibility's for the reason that I made it for multiple people with different preferences. (See dwg. file below for block). Is this at all possible? Callout_GL.dwg
  13. Hi, I need help. My AutoLISP works well in DWG To PDF but it comes out 1 file per 1 DWG. I want it to be the only PDF file. Can somebody help me with something? (I can't use third party programs) Thank you for your help. The examples are in my attachments. My_Plot.LSP Test.dwg
  14. I can convert my raw AutoLISP (.lsp) codes into Visual Lisp (.VLX) and .FAS application using AutoCAD VLISP IDE. I was looking into Autodesk App Store and downloaded some of the free applications. It was .msi. That means it will install directly on Windows and link-up with installed AutoCAD. I am very new in the App Store. Could you please help me to understand to convert my .lsp or .vlx or .fas into .msi? Thanks.
  15. I did a program in Autolisp, so I want to encript that in order to avoid hacks. What would you recommend me? Because I want rent it. Im a beginner, so I dont know to much about the topic. Thanks to much for your advices
  16. Hello Dear Friends, how to do the automatically offset in between two lines offset centerline for all. kindly find the attached for sample image with drawing. if anyone knows lisp please help me. I am using AutoCAD 2017 Thanks Amarendra HVAC sample Offset.dwg
  17. Dear all, I have lisp dcl and data files working together to draw steel sections. I have done all the sections modified to indian standards originally it was written for british standards and it is free of copy rights. Since the author has changed to catia 3 dacades before. Please find attached images of error, dialog box and lisp files,data files and dcl files. This may looks like a big job. If any lisp expert available he can do it seconds. As I have done whole lot of things with minimum lisp knowledge. Thanks Krish stl_ipn.dat stl_rsj.dat stl_deflt.dat STL.LSP stl_rtee.dat stl_ub.dat stl_rhs.dat stl_shs.dat stl_uc.dat stl_ursa.dat stl_ersa.dat stl_chs.dat stl_rsc.dat stl_pfc.dat stl_ipe.dat rec.dwg stl_passwd.dat stl_pipe.dat stl_steeub.dat stl_steeuc.dat stl_u.dat stl_ubp.dat stl_upn.dat stl_wash.dat README.TXT stl.dcl stl.slb stl_cap.dat stl_csk.dat stl_cub.dat stl_cuc.dat stl_hd.dat stl_he.dat stl_hex.dat stl_hl.dat stl_hp.dat stl_hx.dat
  18. Im beginner, I have this: (setq p1 (getpoint "\nPunto Inicial:")) (setq p2 (polar p1 (* 1.5 pi) 0.5)) (entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2) '(62 . 2))) So, the line I drawn is the yellow one below in the image. And, the text I want put is the magenta one. how can I do this? Thanks for your help
  19. Im a begginer, I drawn a line in autolisp with this "code": (setq p1 (getpoint "\nPunto Inicial:")) (setq p2 (polar p1 (* 1.5 pi) 0.18)) (command "line" p1 p2 "") but, how can I change the color of this line?? For example I want yellow Thanks for your help.
  20. Hey guys, I'm looking to assign a custom property to a variable and I have no idea how to do it. In the 0 custom prop I put a testvalue Here is the code I have so far: (vl-load-com) (defun c:test (/) (setq acadObject (vlax-get-Acad-Object) acadDocument (vla-get-Activedocument acadObject) ;; set existing custom properties to dProps dProps (vlax-get-property acadDocument 'Summaryinfo) ) ;; get the value at the specifed index in the dProps and assign it to location (vla-GetCustomByIndex dProps 0 "IMPCSVLOC" location) ) I can't find any documentation on the "vla-GetCustomByIndex" so I don't really know how to use tbh. I've attached a file that has the custom property setup. All insight and help is appreciated. Thanks, JT testfile.dwg
  21. Hello, I am looking for a lisp that will allow me to increment an attribute in a block from one block to the next by doing a window selection. The lisp that I have now that I got from Chaitanya Chikkala (see below) works great, but I have to select each block individually. With 2000+ blocks it is easy to make a mistake. When I window select with it, it numbers them as they were added to the drawing. This does not work for me because multiple people work on drawings and then are combined into a master drawing so the order is wrong. Is there a way for a direction to be added, even if it is just along the x or y axis? Or is there a lisp that already does this? Any help is very much appreciated. (defun c:incr (/ ent obj x i ST_STR) (command "._undo" "_be") (SETQ ST_STR1 (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY ALPHABET/WORD)")) (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY INTEGER)")) (vl-load-com) (setq i 0) (prompt "\nSelect blocks one at a time and in order") (SETQ BLOCK_LIST (SSGET)) (SETQ BLOCK_LIST (FORM_SSSET BLOCK_LIST)) (while (< I (LENGTH BLOCK_LIST)) (SETQ ST_STR (STRCAT "" ST_STR)) (SETQ TEMP_ELE (NTH 0 (ATTRIBUTE_EXTRACT (NTH I BLOCK_LIST)))) (SETQ TEMP_ATTRIBUTE (STRCAT ST_STR1 ST_STR)) (SETQ TEMP_TAG (NTH 0 TEMP_ELE)) (MODIFY_ATTRIBUTES (NTH I BLOCK_LIST) (LIST TEMP_TAG) (LIST TEMP_ATTRIBUTE)) (SETQ ST_STR (ITOA (+ (ATOI ST_STR) 1))) (setq i (+ i 1)) ) (command "._undo" "_e") (princ)) (DEFUN FORM_SSSET (SSSET / I TEMP_ELE LIST1) (SETQ I 0) (SETQ TEMP_ELE NIL) (SETQ LIST1 NIL_) (WHILE (< I (SSLENGTH SSSET)) (SETQ TEMP_ELE (SSNAME SSSET I)) (SETQ LIST1 (CONS TEMP_ELE LIST1)) (SETQ I (+ I 1)) ) (REVERSE LIST1) ) (DEFUN ATTRIBUTE_EXTRACT (ENTNAME / ENT_OBJECT SAFEARRAY_SET I LIST1) (SETQ SAFEARRAY_SET NIL) (SETQ ENT_OBJECT ENTNAME) (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT)) (IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE) (PROGN (SETQ SAFEARRAY_SET (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES") ) ) ) (SETQ I 0) (SETQ LIST1 NIL) (WHILE (< I (LENGTH SAFEARRAY_SET)) (SETQ LIST1 (CONS (LIST (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING") (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING") ) LIST1 ) ) (SETQ I (+ I 1)) ) (SETQ LIST1 (REVERSE LIST1)) (SETQ LIST1 (SORT_FUN LIST1 0 0))) (SETQ LIST1 NIL) )LIST1 ) (DEFUN MODIFY_ATTRIBUTES (ENTNAME IDENTIFIER VALUE / TEMP_ELE ENT_OBJECT SAFEARRAY_SET I J) (SETQ SAFEARRAY_SET NIL) (SETQ ENT_OBJECT ENTNAME) (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT)) (IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE) (PROGN (SETQ SAFEARRAY_SET (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES") ) ) ) (SETQ I 0) (SETQ J 0) (SETQ LIST1 NIL) (WHILE (< I (LENGTH SAFEARRAY_SET)) (SETQ TEMP_ELE (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING")) (IF (/= (VL-POSITION TEMP_ELE IDENTIFIER) NIL) (PROGN (VLAX-PUT-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING" (NTH (VL-POSITION TEMP_ELE IDENTIFIER) VALUE)) )) (SETQ I (+ I 1)) ) ))) (DEFUN SORT_FUN (LIST1 FLAG1 FLAG2 /) (IF (= NIL (VL-CONSP (CAR LIST1))) (PROGN (SETQ LIST1 (INDEX_ADD LIST1)) (SETQ LIST1 (VL-SORT LIST1 '(LAMBDA (X Y) (< (CADR X) (CADR Y))) ) ) (SETQ LIST1 (MAPCAR '(LAMBDA (X) (CADR X)) LIST1)) ) (PROGN (IF (NOT (ATOM (NTH FLAG1 (NTH 0 LIST1)))) (SETQ LIST1 (VL-SORT LIST1 '(LAMBDA (X Y) (< (NTH FLAG2 (NTH FLAG1 X)) (NTH FLAG2 (NTH FLAG1 Y))) ) ) ) (PROGN (SETQ LIST1 (VL-SORT LIST1 '(LAMBDA (X Y) (< (NTH FLAG2 X) (NTH FLAG2 Y))) ) ) ) ) ) ) LIST1 )
  22. Hello is it possible to make lisp to extract coordinates from several polyline lines and their titles in the form of a .txt file? I have an example of the attachment below, I hope someone can help me, thank you. OUTPUT.txt MASTER CROSS SECTION.dwg
  23. Hi, I'm new around here so, I couldn't find the solutions please don't mad me if this request already written by someone else. And also sorry about my grammer either The thing what I want to do : I have a folder and this folder is include many dwg files. And these dwg files contetnts one or more layouts. I'm using Enhanced Attribute Editor for keep data like; <drawing number>, <drawing name>, <date>, <revision no> etc. So I need a lisp for export these data to an excel file . thanks in advance for any help Truly Regards
  24. I just discovered that I can put a line in my lispfile like this: [Some notes]. When I load the lispfile the line is ignored. In other words it acts like comment. Comes in handy because I can use another type of comment, But . . . . . . Do I rely on a rule here or will I get into trouble later when using the code? Thanks in advance, André
  25. Alan_KD

    XREF layer

    Hello everyone, I have been developing some routines for the pas 6 months, so my knowledge is not very high. Normally I manage to find answers online, thanks to all of you who share their knowledge, it's so helpful. I am writing a routine which would: Compare the XREF name on the drawing and the XREF 'real' file name and match them (on the drawing) if different. After the code checks if the XREF name matches a specific formatting and if it does creates a layer based on it (if the layer does not already exist). The final step is to change the XREF layer to that one, and here is where I am getting an error. I tried with different ways to do this and always got an error. I guess I could try to get this done without using vl code but this is really puzzling me and I would like to know why is actually not working, I dont see where the code could have gone wrong. The example names of my XREFs: which are used to compare with the wcmatch "*_*_*_*" XREF_TGLMTE_PRO_INTER_BASSINS_01 XREF_TGLMTE_PRO_INTER_RESEAUX_HS_2025_01 XREF_TGLMTE_PRO_TRC_V5_IND_D I used different lines of code to try to achieve this, as you can see on my commented lines on the code. I am currently using a (vlax-put-property it2 'layer strcalq) inside a vlax-for getting the following error: (defun c:xrcalque (/ AcadObj AcadAct LyAct it2 xrobjectname strcalq) (vl-load-com) (setq *error* ABD:Error) (setq AcadObj (vlax-get-Acad-Object)) (setq AcadAct (vla-get-ActiveDocument AcadObj)) (setq LyAct (vla-get-layers AcadAct)) ;get layers from Active document (xrn AcadObj AcadAct); runs the subroutine to change XREF name on drawing to match XREF file name (vlax-for it2 (vla-get-blocks AcadAct) (setq ind1 3) (setq ind2 0) (setq ind3 0) (if (= (vla-get-isxref it2) :vlax-true) (progn (setq xrobjectname (vl-filename-base (vla-get-name it2))) (if (wcmatch xrobjectname "*_*_*_*"); (progn (repeat ind1 (setq ind3 (+ ind2 1)) (setq ind2 (vl-string-position (ascii "_") xrobjectname ind3));gets firs position of "_" character ) (print xrobjectname) (setq ind2 (+ ind2 2)) (print ind2) ; ind2 is the position of the ind1 "_" element (3rd) to count from there to have the layer name (setq ind4 (vl-string-position (ascii "_") xrobjectname nil T)); last "_" position (setq ind5 (vl-string-position (ascii "-") xrobjectname nil T)); last "-" position (if (> ind4 ind5)(setq indlst ind4)(setq indlst ind5)) ;check which one is bigger (setq indlst (+ 1 indlst)) (setq strcalq (strcat "SF-XREF_"(substr xrobjectname ind2 (- indlst ind2)))) ;Create layer with string from ind2 position to ind4 or ind5 position (strcalq) (print strcalq) (if (not (tblsearch "LAYER" strcalq));checks non existance of layer (progn (vla-add LyAct strcalq) (print "Layer has been created") ) (progn ;(vla-put-layer it2 "0") ; (print "this is a test4") (print "layer exists") ;if layer exists put object on layer ) );if (print strcalq) ;(vla-put-layer it2 "0") ;(vla-put-layer xrobjectname strcalq) ;(vla-put-layer (vla-get-name it2) strcalq) ;(vlax-put it2 'Layer "0") ;(vlax-put (vlax-ename->vla-object (vla-get-name it2)) 'Layer "0") (vlax-put-property it2 'layer strcalq);############ ERROR############### );progn (print "wcmatch xref name not matching") );if );progn );if ;(vlax-put (vlax-ename->vla-object xrtemp) 'Layer strcalq) );vlax for (print "highly recommended to purge layers") ;add code to purge automatically the layers? (princ) );defun ;;;======================================= Error function ++++++++++++++++++++++++++++++++++++++++;;; (defun ABD:Error (st) (if (not (member st (list "Fonction annulée" "quitter / sortir abandon"))) (vl-bt) );if ;(princ "Merci d'envoyer vos commentaires ou report d'erreurs à ") (princ);clean exit ? );defun error ;;;======================================= function xrn +++++++++++++++++++++++++++++++++++++++++++;;; (defun xrn (AcadObj AcadAct / item xrobjectnamexrn xrfilenamexrn) (vlax-for item (vla-get-blocks AcadAct) (if (= (vla-get-isxref item) :vlax-true) (progn (setq xrobjectnamexrn (vl-filename-base (vla-get-name item))) (setq xrfilenamexrn (vl-filename-base (vla-get-path item))) (if (/= xrobjectnamexrn xrfilenamexrn) (progn (vla-put-name item xrfilenamexrn) (vla-reload item) ) ) ) ) ) );defun xrn If someone could explain why this is not working, and please share a way to achieve my goal would be awesome! Thank you in advance, Alan
×
×
  • Create New...