Search the Community

Hi there! I've watched this tutorial and have a few questions: 1. how can I load the full project in the current drawing from Visual Studio Code? Currently, I'm able to only attach the currently opened lsp file and have to load the other manually, one by one. In the visual lisp editor, there was a button to load all the files inside the project. I have a big project divided into a few files that also load an opendcl interface and I need to load them all to debug the whole program or it will not work. 2. how can I compile in fas from vscode? Probably is not possible so I have to use the original visual lisp editor. But how can I load it now? The vlisp command starts the vscode and I don't know how to start the old editor. Thanks! Dennis

Hi all, I am attempting to get a viewport from blocks in modelspace to paperspace with a layout template. I would like this automated by selecting all the blocks in numerical order and placing them on the correct numbered layout. I have found plenty of lisp out there, but nothing that seems to work 100%. I know there are programs out there, but I want to try to learn autolisp with this project. I think I was able to get close with these two: Draw bounding box on object-from Blackbox Create multiple viewport from multiple rectangle in model space-from hmsilva The main difference I want to change below is to select all of my objects, instead of being prompted to select a single object, (defun c:BNDBX (/ eName mn mx) (vl-load-com) (if (setq eName (car (entsel "\n >> Select Object >> "))) (progn (vla-getboundingbox (vlax-ename->vla-object eName) 'mn 'mx) (vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx)))) (princ) ) ) I have tried inserting (if (setq eName (ssget "_x" '((0 . "INSERT") (2 . "PageView")))) on the 3rd line with no success. Eventually I would like to have the second code produce layouts in order. But I figured I would get this chunk sorted first.

Hi, I've written this code which draws triangles on the inside or outside of a polyline (with multiple vertexes), but it gives increasingly better/worse results depending on the zoom level (better results are obtained with higher zoom). The zoom levels I'm talking about are such that when the polyline occupies the whole screen it does work with some errors, if you reduce the zoom then it does not work, and when you increase the zoom it works perfectly. It probably depends on the relative size of the triangles (which are user inputs) to the zoom level. Is there a way to correct this behavior? (defun c:vert (/ obj1 oft wid spa ip obj2 len l1 l2 sp pt1 pt2 ptm slopeP slopeM ptt1 ptt2 pttR pttL ptt pss it) (vl-load-com) (setq obj1 (ssget C) oft (float (getreal "Triangle height: ")) wid (float (getreal "Triangle width: ")) spa (float (getreal "Distance between triangles: ")) ) (setq ip (strcase (getstring "R(ight) or L(eft): "))) (setq obj2 (vlax-ename->vla-object (ssname obj1 0)) len (vlax-get-property obj2 "length") l1 (float 0) l2 (float wid) ) (while (< l1 len) (setq sp (vlax-curve-getPointAtDist obj2 0) pt1 (vlax-curve-getPointAtDist obj2 l1) pt2 (vlax-curve-getPointAtDist obj2 l2) ptm (vlax-curve-getPointAtDist obj2 (/ (+ l1 l2) 2)) slopeP (+ (if (= (car pt2) (car pt1)) (/ pi 2) (atan (/ (- (nth 1 pt2) (nth 1 pt1)) (- (nth 0 pt2) (nth 0 pt1))))) (/ pi 2)) slopeM (- (if (= (car pt2) (car pt1)) (/ pi 2) (atan (/ (- (nth 1 pt2) (nth 1 pt1)) (- (nth 0 pt2) (nth 0 pt1))))) (/ pi 2)) ptt1 (list (+ (nth 0 ptm) (* oft (cos slopeP))) (+ (nth 1 ptm) (* oft (sin slopeP)))) ptt2 (list (+ (nth 0 ptm) (* oft (cos slopeM))) (+ (nth 1 ptm) (* oft (sin slopeM)))) pttR (if (< (- (* (- (nth 0 pt2) (nth 0 pt1)) (- (nth 1 ptt1) (nth 1 pt1))) (* (- (nth 0 ptt1) (nth 0 pt1)) (- (nth 1 pt2) (nth 1 pt1)))) 0) ptt1 ptt2) pttL (if (> (- (* (- (nth 0 pt2) (nth 0 pt1)) (- (nth 1 ptt1) (nth 1 pt1))) (* (- (nth 0 ptt1) (nth 0 pt1)) (- (nth 1 pt2) (nth 1 pt1)))) 0) ptt1 ptt2) ptt (if (= ip "R") pttR pttL) ) (command "_.pline" pt1 ptt pt2 "") (setq l1 (float (+ l1 wid spa)) l2 (float (+ l2 spa wid)) ) ) )

hello everybody , hope u all are great ... i have this lisp to get sum of some texts in autocad by choosing them one by one , but instead i wanna select those texts in one time by one selection click for them all ... i really appreciate ur help thanks in advance ;; wrriten by dlanorh from cadtutor (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun (vl-load-com) (defun c:t+ ( / *error* sv_lst sv_vals ent elst el num xsf ans tot qflg nlst sel pt txt) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_defun (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt) sv_vals (mapcar 'getvar sv_lst) );end_setq (mapcar 'setvar sv_lst '(0 0 3 1)) (while (not tot) (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : "))))) (cond ( (wcmatch (cdr (assoc 0 el)) "*TEXT") (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")) xsf (cdr (assoc 41 el)))) (t (setq num (atof (getpropertyvalue ent "Text")) xsf 1.0)) );end_cond (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")) (t (setq tot num))) ) (t (alert "Not a Text Entity")) );end_cond (cond (num (setq nlst (cons ent nlst)))) );end_while (while (not qflg) (setq sel (entsel "\nSelect Next Text Number Entity : ")) (cond ( (not sel) (initget "Yes No") (setq ans (cond ( (getkword "\nSelection Finished [Yes/No] <No>")) ("No"))) (if (= ans "Yes") (setq qflg T)) ) );end_cond (cond ( (and (not qflg) sel) (setq elst (entget (setq ent (car sel)))) (cond ( (and (wcmatch (cdr (assoc 0 elst)) "*TEXT") (not (vl-position ent nlst))) (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")))) (t (setq num (atof (getpropertyvalue ent "Text")))) );end_cond (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number"))) ) ( (vl-position ent nlst) (alert "Already Selected") (setq num nil)) (t (alert "Not a Text Entity")) );end_cond (if num (setq tot (+ tot num) nlst (cons ent nlst) num nil)) ) );end_cond );end_while (cond ( (and tot qflg) (setq pt (getpoint "\nSelect Total Insertion Point : ") txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)) );end_setq (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) xsf) (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o))) ) );end_cond (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun

Hello people i have problem with using server path in autolisp. Everything work fine with normal path like "G:\Trudy-menu\ ...." but i cant use "\\46.48.10(random IP)\Network\Trudy-menu\.... if someone can help i will be glad. I want to get files from the path and create folders if it need. Thank you.

Hi Everyone, From few days I'm trying to make an auto lisp which can understand the difference between 2 different layers and calculate area according to that. Unfortunately I'm not getting proper results anyone can please help. I was trying to create the lisp in below steps. Step-1: After entering command user will select whole drawing in single selection Step-2: Lisp will select only object in Layer-1 & Layer-2 (Other layers objects will be ignored) Step-3: Lisp will calculated the area of Layer-1 & Layer-2 Step-4: Now it will Subtract the area of Layer-2 from Layer-1 Step-5: and paste it as Text.

Hello everyone, I hope you all healty and feeling hapy. Many greeting to you from capital of the Turkey I've a problem about syntax of my lisp that can print perimeter and area to attribute (Especially Room Tag). I tried many times to fix this error but I never find a solution about my problem. Thank you That's my lisp; ;;;;;; ;;;;;;; (defun AREA_PERIMETER_SEC () (prompt "\nSelect a closed POLYLINE") (setq sonobje (car (entsel))) (if sonobje (progn (setq silobje sonobje) (redraw silobje 3) (command "area" "e" sonobje) ;(alert "Bulunan alan.") (setq alan (/ (getvar "area") 10000)) (setq cevre (/ (getvar "perimeter") 100)) (print)- (prompt (strcat "Bulunan alan ve cevre: " (rtos alan 2 2) "m² " (rtos cevre 2 2) "mt. " ) ) ) ;progn (progn (alert "Kapali alan bulunamadi.Tekrar deneyin.") (exit) ) ) ;if ) ;;;;-----MAIN PROGRAM----- (defun DEGIS (ss es-alan es-cevre / ye-alan ye-cevre) (setq ye-alan (cons 1 (rtos alan 2 2))) (setq ye-cevre (cons 1 (rtos cevre 2 2))) (entmod (subst ye-alan es-alan (entget (entnext (entnext (entnext ss))) ) ) ) (entmod (subst ye-cevre es-cevre (entget (entnext (entnext (entnext (entnext ss))) ) ) ) ) (entupd ss) (print) (prompt (strcat "Onceki alan ve cevre: " (cdr es-alan) "m² " "mt. " ) ) (print) (prompt (strcat "Yazilan alan ve cevre: " (cdr ye-alan) "m² " (cdr ye-cevre) "mt. " ) ) (princ) ) (defun C:RAPT () ; (/ obje x) (setq objeler nil silobje nil ) ;;(prompt "\nHesaplanacak alani,") (initget "Orta Ciz Sec") (setq sec (AREA_PERIMETER_SEC)) (setq ss (car (entsel "\nChoose the ROOM NUMBER to be CHANGED") ) ) (setq x 0) (if ss (progn (setq obje (substr (strcase (cdr (assoc 2 (entget ss)))) 1 7)) (setq es-alan (assoc 1 (entget (entnext (entnext (entnext ss))) ) ) ) (setq es-cevre (assoc 1 (entget (entnext (entnext (entnext (entnext ss)) ) ) ) ) ) (if (= obje "MTAG") (DEGIS ss es-alan es-cevre) ) ;if ) ;progn ) ;if (command "") ) (princ)() RAPT.lsp

Hi, I would like to know some help. 01 - Is there a possibility in this Lee Mac lisp, Automatically Label Attributes, that it can be changed so that every time I open a different file it asks me about the increment, prefix and suffix settings? Because in the current way it always loads the pre-configuration that is already in lisp. I don't want to have to edit the lisp to configure the numbers for each file. Note: I use attributed blocks and multileader blocks. 02 - I also use the Lisp Incremental Numbering Suite, I would like to know if the option for multileaders can be added. As the current options are only for text, mtext and blocks. For my use multileaders are more interesting. Because the use of block with attributes will have to be manually making the leader lines to indicate their positions and references after their insertion and when you have many blocks end up wasting valuable time. I would like to know if it is possible to make any of these changes, since lisps have many lines. Note: Sorry for the google translation. #NumIncV3-9.lsp AutoLabelAttributesV1-4.lsp

Hi all, this is a cutout of a dcl file with toggle boxes. How can I predefine the selection "lathe machine"? (So that this checkbox is always checked). Currently, the selection that was previously selected is always applied. With radio-buttons it works with "value=1", but not in this case. : toggle { key = "tool"; label = "lathe machine"; value = "1"; } Thanks so far.

Hi all, I have rebuilt the dcl and lsp files for my purposes. Can someone show me how to query the set variable (with wcmatch or cond)? Thanks in advance. (defun c:MyToggles (/ Dcl_Id% Layout_A1H$ Layout_A2H$ Layout_A3V$ Layout_A3H$ Layout_A4V$ Layout_A4H$ Return#) ;----- set default variables (if (not *MyToggles@) ;unique global variable name to store dialog info (setq *MyToggles@ (list nil "0" "0" "0" "0" "0" "0")) ) (setq Layout_A1H$ (nth 1 *MyToggles@) Layout_A2H$ (nth 2 *MyToggles@) Layout_A3V$ (nth 3 *MyToggles@) Layout_A3H$ (nth 4 *MyToggles@) Layout_A4V$ (nth 5 *MyToggles@) Layout_A4H$ (nth 6 *MyToggles@) ) ;----- load dialog dcl data (setq Dcl_Id% (load_dialog "MyDialogs.dcl")) (new_dialog "MyToggles" Dcl_Id%) ;----- set dialog initial settings (set_tile "A1H" Layout_A1H$) (set_tile "A2H" Layout_A2H$) (set_tile "A3V" Layout_A3V$) (set_tile "A3H" Layout_A3H$) (set_tile "A4V" Layout_A4V$) (set_tile "A4H" Layout_A4H$) ;----- dialog actions (action_tile "A1H" "(setq Layout_A1H$ $value)") (action_tile "A2H" "(setq Layout_A2H$ $value)") (action_tile "A3V" "(setq Layout_A3V$ $value)") (action_tile "A3H" "(setq Layout_A3H$ $value)") (action_tile "A4V" "(setq Layout_A4V$ $value)") (action_tile "A4H" "(setq Layout_A4H$ $value)") (setq Return# (start_dialog)) ;----- Unload Dialog (unload_dialog Dcl_Id%) (setq *MyToggles@ (list nil Layout_A1H$ Layout_A2H$ Layout_A3V$ Layout_A3H$ Layout_A4V$ Layout_A4H$)) (princ) ;c:MyToggles ) MyToggles : dialog { key = "Title"; label = "Layouts"; //title from lsp file spacer; : boxed_column { label = "Get your Layouts:"; width = 34.26; fixed_width = true; : toggle { key = "A1H"; label = "A1 - Horizontal"; } : toggle { key = "A2H"; label = "A2 - Horizontal"; } : toggle { key = "A3V"; label = "A3 - Vertikal"; } : toggle { key = "A3H"; label = "A3 - Horizontal"; value = "1" ; //predefined selection } : toggle { key = "A4V"; label = "A4 - Vertikal"; } : toggle { key = "A4H"; label = "A4 - Horizontal"; } spacer; } spacer; ok_only; } How do I include the variable query here? (cond ((= Layout_A1H$ 1) "selected") ('T "not selected") )

What command can I use to find a block by its name in my drawing and then delete it?

Hi, I'm trying to query the variable "Weight" and if it has the content "50" I want to define a new variable: "Stamp" with the content "internal". Is WCMATCH the right command for this? (if (= wcmatch Weight "50") (progn (setq stamp "intern"))) (princ)

Hi all, I am trying to write a lisp that will create a DropDown list in Autocad. With the selection from the fields I want to execute different commands that I have defined before. (defun c:create_dropdown () (setq choise1 command1) (setq choise2 command2) (setq choise3 command3) (setq choise4 command4) (strcase (initget (getkword [choise1/choise2/choise3/choise4])))) )

Hello all. I need a lisp that will merge all layouts, that start with a certain name, into one PDF file. I have already made some progress with this Lisp. With the dwgprops I get information about the current file path, which I then merge all with the stract command. This also works, only the command "-Export" "ak" can only print one sheet. The number of layouts that start with "Plan..." are always different. Does anyone have an idea which command works instead for publish all Layouts, that beginns with the same name? The -publish command always asks me for a dsd file. (defun c:Documentsheets ( / pdfName ) (vl-load-com) ;--------- get variabel für contact - number: (setq acadObject (vlax-get-acad-object)) (setq acadDocument (vla-get-ActiveDocument acadObject)) (setq dProps (vlax-get-Property acadDocument 'SummaryInfo)) (vla-getCustomByIndex dProps 4 'myValue1 'myValue2) (setq contact myValue2) (princ) ;--------- get variable for order - number: (setq acadObject (vlax-get-acad-object)) (setq acadDocument (vla-get-ActiveDocument acadObject)) (setq dProps (vlax-get-Property acadDocument 'SummaryInfo)) (vla-getCustomByIndex dProps 5 'myValue1 'myValue2) (setq order myValue2) (princ) ;-------- (setq Pathone "\\\\company.lan\\xyz\\erp\\land\\contact\\") (setq Pathtwo "\\order\\") (setq Paththree "\\folder\\") ;-------- (command "_Qsafe") (foreach layname (vl-remove-if-not '(lambda (ln) (vl-some '(lambda (n) (wcmatch ln n) ) '("Plan*") ) ) (layoutlist) ) (setvar "ctab" layname) (setq pdfName (strcat Pathone Contact Pathtwo Order Paththree (strcat order "_Drawing") ) ) ) (if (findfile pdfName) (command "-EXPORT" "PDF" "Ak" "N" pdfName "J") (command "-EXPORT" "PDF" "Ak" "N" pdfName) ) )

Hi to all. I really appreciate the content of this page and so I wanted to ask if anyone has any idea how we could use AutoLISP to design a water supply and sewerage system in our floor plan. Thanks in advance.

Hi Guys, I have several layouts when drawing, which also have different names. I want to save in a Lisp all layouts that start with a specific name in a certain folder as PDF. I am new in lisp, but i have managed to write a lisp that selects the correct location for me. Unfortunately only all layouts are printed. (defun c:Dokument_Export () (command "-EXPORT" "PDF" "ALLE" (strcat (substr (getvar "DWGPREFIX") 1 70) "\\08_Auftragsbestätigung\\" (strcat (substr (getvar "DWGNAME") 1 8) "_Zeichnung") ) ) ) You have any idea? Thanks in advance.

Hello everyone! So, i am doing a school project in which i want to select all circles of a given radius and then move them all in the arithmetic mean of all centers. The arithmetic mean is no problem, everything works fine, till i add the "more complex" filter. Here is the part of the code: (initget 7) (setq radius (getint "\nEnter radius: ")) (setq ss (ssget "X" '((0 . "CIRCLE") (-4 . "=") (40 . radius)))) The thing is, when i swap (40 . radius) with, lets say, (40 . 10)... it works for all circles with the radius equal to 10. But i want to give the radius by keyboard. And i get the error from the title. Also... if i put a (princ radius) before the filter, it shows me the value of radius.

Hello everyone i have this code that im working for sometime... (while (not (setq ent (car (entsel "\nSelect rectangle: "))))) What i want is to change the selection option into ssget with layer filter, so that i would not pick the rectangle one by one and will do the same routine for every rectangle in the selection set.

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 ) )

Hello everyone, is there anyone who have lisp routine for drawing clothoides (spirals) between two arcs or "S" curve and who is willing to share it? I hope so that is not to much to ask for. Best Regards!

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

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

Hello, After a sidestep to Clojure, of course back to AutoLisp. I have quite some exeperience with AutoLisp and on and off I worked with it for almost 20 years now. (Auto)Lisp is known amongst AutoCAD users but further on, the whole lisp-thing doesn't ring a bell with most programmers that I meet. They work with SQL, HTML, XHTML, Java, C# or maybe (V)BA. I stayed interested in Lisp, although limited to AutoLisp. Recently. I discovered that there is a new Lisp called Clojure that is becoming big in the programming world. Possibly due to the fact that it translates to Java or javascript before anything is executed. But this aside. I learned that Clojure is first class because it is capable of accepting a function as a parameter and clojure functions can produce functions. There's a whole lot more to be discoverd about this great language but I leave that to the reader. The subject 'Clojure' is easily found on the web. By taking this interest in Clojure I learned a lot about AutoLisp too. On this page at the subject of 'Closures' halfway the page, there is an example showing how a function is produced in Clojure. Realy, it took me quite some time to grasp it. After that I wanted to know if this could be done with AutoLisp as well. After trials with defun-q-list-set/ref (which also work) I came up with the following. Hart of the solution is (eval (append '(lambda . . Is it the best way to do this? I don't know. Is it useful? I doubt it but see below. Is it interesting? Highly (for me!) (defun messenger-builder (greeting) (setq greeting (strcat "\n" greeting " ")) (eval (append '(lambda (who)) (list (list 'princ (list 'strcat greeting 'who)) '(princ))))) (setq hello-er (messenger-builder "Hello") goodbye-er (messenger-builder "Goodbye")) (defun c:greet_the_world () (hello-er "World!")) (defun c:say_goodbye () (goodbye-er "Everyone!!")) AutoLisp does a great job in AutoCAD. Perfect, but as a Lisp it is less thoroughly designed than Clojure. This shows off in the example above. Clojure handles the subject of producing functions easier. Maybe my example is ill-constructed. I could not find a better solution. Question also is, can we think of any usufull application of this in AutoCAD. Although I took another route in the example, the designated functions for this are (I think) defun-q-list-set/ref. I suppose they are there for a reaon. Or is it all limited to the s::startup example?

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?

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/