Search the Community

Almost every drawing I work on is exported from another Survey program and then Imported into Civil3D as a DXF I have sped up this process with a Lisp command and built in AutoCAD functions but would really like to combine the whole process into one Command. I am not sure if I can modify and combine existing lisps to achieve this or using a Script which I have had no experience with as yet. Below I have outlined the steps, attached the Lisp used and a video (two parts due to size limit) outlining the process that for every job is becoming tiresome. Redefine the inserted Block For some reason when I insert the DXF it does not automatically redefine (Which is needed to update Survey blocks to my custom Acad Blocks. So I have to re-insert the DXF to force redefine "DP" Lisp (Attached) - This routine deletes the crosses that are carried over from our Survey Software and are not required. Explode and set "By Layer" Color, Linetype and Lineweight Attsync two blocks - POINT_CROSS and $FILL Finally I would like to select the Attsync selection (POINT_CROSS and $FILL) and set their scale back to 1 Seems to be that these blocks which I have redefined to be annotative, scale according to the model space when inserted which we don't leave on 1:1 but our most commonly used scales for each template. As always the expertise and help provided here is greatly appreciated. Part One - DXF into Civil3D.mp4 DP (Delete Points).lsp

I found this lisp on this forum, and it is almost perfect for my use case. The one thing i would like it changed about it is that instead of asking for my input for a color, it changes it for a certain one that we set in the code. The thing i would like this code to do: after entering the command and selecting the objects, the color of the object changes right away, without asking for a any input. Appreciate your help in advance! (defun C:CHC (/ ColorObjects CurrColorOrg NewColor CmdEchoOrg) (prompt "\nSelect objects to color...") (cond ( (setq ColorObjects (ssget)) (setq CurrColorOrg (getvar 'CECOLOR) CmdEchoOrg (getvar 'CMDECHO) ) (setvar 'CMDECHO 0) (while (not (cond ( (initget 6) ) ( (setq NewColor (getint "\nEnter object color (1-255) <dialog>: " ) ) (if (< NewColor 256) (setvar 'CECOLOR (itoa NewColor))) ) (T(initdia) (command "_.COLOR") (numberp (read (getvar 'CECOLOR))) ) ) ) (prompt "\nCannot set color to that value.\n*Invalid.*") ) (command "_.CHANGE" ColorObjects "" "_P" "_C" (getvar 'CECOLOR) "") ) ) (setvar 'CECOLOR CurrColorOrg) (setvar 'CMDECHO CmdEchoOrg) (princ) )

Hi all, I came across a LISP routine that freezes the layer of any selected object. It works great but I want it to viewport freeze layers, not freeze for the entire drawing. This is where I found it: http://forums.augi.com/showthread.php?78426-Special-Layer-Freeze-LISP-Routine and this is the code I'd like to have modified: (the code wrap button doesn't seem to work) (defun c:LFR (/ CLayer$ EntList@ EntName^ Layer$) (setq CLayer$ (getvar "CLAYER")) (princ "\nSelect object on layer to freeze") (if (setq EntName^ (car (entsel))) (progn (setq EntList@ (entget EntName^)) (setq Layer$ (cdr (assoc 8 EntList@))) (if (and (= Layer$ CLayer$)(/= Layer$ "0")) (command ".LAYER" "T" "0" "U" "0" "ON" "0" "S" "0" "") );if (if (= Layer$ "0") (princ "\nCannot freeze layer 0.") (command ".LAYER" "F" Layer$ "") );if );progn );if (princ) );defun c:LFR [code] I also attached the actual .LSP file to make it easier. LFR.LSP

Hello CADians , I couldn't find a solution to this problem anywhere online. I am also essentially a newbie when it comes to AutoLISP as I have only learned the language ad-hoc to meet certain needs of my business. I have a lisp routine that reads a text file, each line has coordinates depths and descriptions. I use the substr function to get each item of info out of every line. Everything works fine up to this point. However when I use ATOF (after some testing) it rounds the value to 6 significant figure. For example, if I use ATOF on the string "543334.243" it returns 543334.0, "9543334.243" returns 9.54333e+06 and "43334.243" returns 43334.2. So when I use this routine to create points with more than 6 significant figures I get issues with the rounding. Is there an alternative function I can use? I have tried DISTOF but it gives me the same result. Is it a setting or something I can change? I am currently using AutoCAD 2017 and I use the VLIDE to write and edit the code I use. This particular code was written a while ago originally for AutoCAD R14 it worked for that and still does actually. Here is the Code ;READ_MRG.LSP ;reads ASCII M-file <name.ext> created by MERGE_WS.BAS ;and inserts PT blocks 950 on each layer of the type _PTS# ;format of file must be: ;Name/1-7, East/9-19, North/21-31, Depth/33-41, Rmks/43-55, ;Seabed GPS El 57-65, Acc 67-68, Exact 70-71 ;Exact shows whether interpolation was needed ;Read Hydro in ACAD File|ASC In/Out calls this program ;---------- (defun setcol() (setq na1 1 na2 7 ea1 9 ea2 11 no1 21 no2 11 dp1 33 dp2 9 rm1 43 rm2 13 el1 57 el2 9 acc1 67 acc2 2 xa1 70 xa2 2) ) ;---------- (defun C:READ_MRG ( / fname s f tx name east north depth elev rmks pt1) (setvar "ATTDIA" 0) (setvar "ATTREQ" 1) ;get existing file (setq fname (getfiled "Select M... file: " "" "" 0)) (if f (close f)) (if (setq f (open fname "r")) (progn ; (command "LAYER" "M" "_weak" "") ; (command "LAYER" "M" "_bad" "") (princ "\nReading and inserting ...\n") (setcol) (setq tx (read-line f)) (setq lyrnum 0) (setq ptnum 0) (while tx (if (= 0 ptnum) (progn (setq lyrnum (+ 1 lyrnum)) (command "LAYER" "M" (strcat "_PTS" (rtos lyrnum 2 0)) "") (setq ptnum 0) ) ) (if (/= (substr tx 1 1) ";") ;ignore remark and header lines (progn (putpt) (if (= ptnum 949) (setq ptnum 0) (setq ptnum (+ 1 ptnum)) ) ) ) (setq tx (read-line f)) ) ;while tx (close f) ) ) ;if f (princ) ) ;---------- (defun putpt () (setq name (substr tx na1 na2) east (substr tx ea1 ea2) north (substr tx no1 no2) depth (substr tx dp1 dp2) rmks (substr tx rm1 rm2) elev (substr tx el1 el2) acc (atoi (substr tx acc1 acc2)) xact (substr tx xa1 xa2) name (rtos (atof name) 2 0) [color="red"]east (atof east) north (atof north) depth (atof depth)[/color] pt1 (list east2 north2) ) (if (= depth2 -32767.0) (setq depth2 "") (setq depth2 (rtos depth 2 3)) ) (command "INSERT" "PT" pt1 1 1 0 depth2 name rmks) ; (if ; (> acc 3) ; (command "CHPROP" "L" "" "LA" "_weak" "") ; ) ; (if ; (> acc 6) ; (command "CHPROP" "L" "" "LA" "_bad" "") ; ) ) Any help would be greatly appreciated. Thanks in Advance. Robin

Hello, I am new in coding lisp files. I worked with vb.net so this is very strange for me at this moment . I want to to select two points with different coordinates and to calculate difference between Z. I want to label that difference and to draw line with specific length under text. I did some coding which I pasted below but it wont draw line. I think that somehow I can not create pt2 and use it. Please help me because my head will blow... Code is below... THANKS (defun c:raz ( / p textloc p1 p2) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq p (getpoint "Odaberite tacku terena: ")) (setq zt (rtos (caddr p))) (setq pomocni 1) (setq p5 (getpoint "Odaberite tacku toplovoda: ")) (setq zc (rtos (caddr p5))) (setq p1 (getpoint "\nOdaberi poziciju teksta.")) (setq y (rtos (car p1))) (setq x (rtos (cadr p1))) (setq z (rtos (caddr p1))) (setq thetext (vla-AddText mspace zt (vlax-3d-point (car p1) (cadr p1) [lz] ) "0.65")) (setq TTT (atof(cadr p1))) (setq p2 (list (+ TTT 2.24) (cadr p1) (caddr p1))) (setq YY (- x pomocni)) (command "Line" p1 p2 "") )

Hi, brand new to this site and my very first thread! I am trying to write a LISP routine and basically have no experience with it except for opening them up and trying to decode it for my self. I am going over lisp basics right now but thought I would through this out there in hopes of learning something from you fine folks. What I need to do is draw a series of circles and rectangles and label them from values in a .CSV file. As I mentioned I am going over the basics and am having trouble keeping my head above water, so be kind please. Thanks in advance, CADINATOR

First of all, congrats on this nice forum and was i can tell a nice community. I need some help with a lisp code, because i can understand some of the code but in reality im a copy e paste "coder" ... The code im sending its a compilation of some free lips i found and i tweak it to fit my own meanings. The purpose of this, is to make a excel sheet with the distance for all lines, polylines, arc's i select in an drawing by layer. But I have a error on the code and i don't know how to fix it, the lisp is getting all the distances of my selection for polylines and arc's, but when i select just lines the result i'm getting its the distance for all the lines in the drawing, i need to narrow the result just to the objects i selected. Can u help with this? Many thanks (defun c:medz (/ elist en i layer layer_list leng pline row ss sumlen total x xlApp xlBook xlBooks xlCells xlSheet xlSheets ) (vl-load-com) (setq xlApp (vlax-get-or-create-object "Excel.Application") xlBooks (vlax-get-property xlApp "Workbooks") xlBook (vlax-invoke-method xlBooks "Add") xlSheets (vlax-get-property xlBook "Sheets") xlSheet (vlax-get-property xlSheets "Item" 1) xlCells (vlax-get-property xlSheet "Cells") ) (vla-put-visible xlApp :vlax-true) ;headers (vlax-put-property xlCells "Item" 1 1 "Layer") (vlax-put-property xlCells "Item" 1 2 "Length") (setq row 2 total 0) (setq ss (ssget (list (cons 0 "*POLYLINE,*LINE,*ARC"))) i -1) (repeat (sslength ss) (setq en (ssname ss (setq i (1+ i))) elist (entget en) layer (cdr (assoc 8 elist))) (if (not (member layer layer_list)) (setq layer_list (cons layer layer_list)))) (repeat (length layer_list) (setq layer (car layer_list)) (setq ss (ssget "_X" (list (cons 0 "*POLYLINE,*LINE,*ARC")(cons 8 layer))) i -1 sumlen 0) (repeat (sslength ss) (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i))))) (setq leng (vlax-curve-getdistatparam pline (vlax-curve-getendparam pline))) (setq sumlen (+ sumlen leng))) (vlax-put-property xlCells "Item" row 1 layer) (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 0)) (setq total (+ total sumlen)) ;;; (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units (setq layer_list (cdr layer_list)) (setq row (+ row 1)) ) (setq row (+ row 1)) ; footers: (vlax-put-property xlCells "Item" row 1 "Total:") (vlax-put-property xlCells "Item" row 2 (rtos total 2 0)) ;;;(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units (mapcar (function (lambda(x) (vl-catch-all-apply (function (lambda() (progn (vlax-release-object x) (setq x nil))))))) (list xlCells xlSheet xlSheets xlBook xlBooks xlApp) ) (alert "Abriu automaticamente o Excel com as distancias pedidas") (gc)(gc) (princ) ) (princ "\t\t***\t Escrever o comando medz, para correr a aplicação\t***") (princ)

I am in a hurry with the project so I don't have time to write this lisp myself specially couse I don't have any experience in it, so if anyone can help that would be great. Anyway I have a lot of parcels drawn in autocad and what i need to do is trim all the polyline endings and intersections and insert a point in the middle. Manually I do it this way: - first i make circles (radius has to be 0.5) on the endings and intersections of polylines - then I trim all the lines inside the circles - then I insert a point in the center of circles and at the end delete circles. There is also a picture at the bottom showing the first and the last fase of the process. If anyone knows about the lisp that does that or maybe have time to write one it would help me a lot. Thanks in advance. :-)

ok, so there's not 5 strcats, but i thought the title was catchy. so i've been making this NEW autolisp based off one i made last week of other people's code i cobbled together and personalized. everything works EXCEPT the little equation i put in. here is the working code BEFORE i updated it: (defun c:ptdif (/ p p1 p2 p3 x y z x1 y1 z1 x2 y2 z2 mdl pdiff ptcoord textloc cs_from cs_to) (while ;start while (setq cs_from 1) (setq cs_to 0) (setq p (getpoint "\nCHOOSE MODEL")) (setq p2 (getpoint "\nCHOOSE SHOT")) (setq textloc (getpoint p "\nPLACE TEXT")) (setq p1 (trans p cs_from cs_to 0)) (setq p3 (trans p2 cs_from cs_to 0)) (setq x (rtos (car p1))) (setq y (rtos (cadr p1))) (setq z (rtos (caddr P1))) (setq x2 (rtos (car p3))) (setq y2 (rtos (cadr p3))) (setq z2 (rtos (caddr p3))) (setq ptcoord (strcat "Model: X = "x" Y = "y" Z = " z)) (setq mdl (strcat "Sokkia: X = "x2" Y = "y" Z = " z2)) (command p2) (command "_leader" p textloc "" ptcoord mdl "") (princ) ) ;end while ) now that works nice and neat. The envelope i'm trying to push it just to add one more string into the text box with the differences between "x and x2" and the y's and the z's. i'll show you what i tried that didn't work. i think i was pretty close. (defun c:ptdif ( / p p1 p2 p3 p4 x y z x1 y1 z1 x2 y2 z2 x3 y3 z3 mdl ptd ptcoord textloc cs_from cs_to) (while ;start while (setq cs_from 1) ; these two keep it in world coords (setq cs_to 0) (setq p (getpoint "\nCHOOSE MODEL")) ; all my get points and prompts (setq p2 (getpoint "\nCHOOSE SHOT")) (setq textloc (getpoint p "\nPLACE TEXT")) (setq p1 (trans p cs_from cs_to 0)) ; the compliment to keeping it in world coords (setq p3 (trans p2 cs_from cs_to 0)) (setq x (rtos (car p1))) ; breaks up x, y, and z from 1st getpoint (setq y (rtos (cadr p1))) (setq z (rtos (caddr P1))) (setq x2 (rtos (car p3))) ; breaks up x, y, and z from 2nd getpoint (setq y2 (rtos (cadr p3))) (setq z2 (rtos (caddr p3))) [b](setq x3 (- x x2)) (setq y3 (- y y2)) (setq z3 (- z z2))[/b] (setq ptcoord (strcat "Model: X = "x" Y = "y" Z = " z)) (setq mdl (strcat "Sokkia: X = "x2" Y = "y2" Z = "z2)) [b](setq ptd (strcat x3 y3 z3))[/b] (command p2) (command "_leader" p textloc "" ptcoord mdl ptd "") (princ) ) ;end while ) i've been googling my ass off and all my research says that my "equation" is correct, but i keep getting "error: bad argument type: numberp: "20.0212" " now if i got "nil" back, i would revise things, but that tells me it stops at the equation, right? sorry for my ignorance, i've just started doing this last week. any help would be REALLY awesome. thanks for read this at least.