Search the Community

Hello, i want to ask if it possible to create lisp who can change coordinates on multiple polyline. Something like, few polylines with coordinates (№ X Y) 1 100 200 2 200 250 3 300 210 4 150 220 5 110 250 and i want to export in .txt file all of the lines and their coordinates and change them, after the change i want to replace this coordinate(№ 1,2,3,4,5) with the new. Something like export-->change-->and replace Same line but with other coordinate. Sorry for my english. Thak you

Hello, I'm using a nice LISP which lists the segments length of a polyline you select, but I would just like to add shortest, longest and average below the text "total polyline length is..." like MIN: xx MAX: yy AVG: zz (defun c:Test (/ T_Entity T_Object T_Start T_End T_SegmentLengths T_Count) (if (and (setq T_Entity (car (entsel "\nSelect polyline: "))) (= (vla-get-ObjectName (setq T_Object (vlax-ename->vla-object T_Entity))) "AcDbPolyline") ) (progn (setq T_Start (vlax-curve-getStartParam T_Object)) (setq T_End (vlax-curve-getEndParam T_Object)) (while (< T_Start T_End) (setq T_SegmentLengths (append T_SegmentLengths (list (- (vlax-curve-getDistAtParam T_Object (setq T_Start (1+ T_Start))) (vlax-curve-getDistAtParam T_Object (1- T_Start)))))) ) (setq T_Count 0) (foreach T_Item T_SegmentLengths (princ (strcat "\nSegment " (itoa (setq T_Count (1+ T_Count))) ": " (rtos T_Item (getvar "LUNITS") 6))) ) (princ (strcat "\n\n ** Total polyline length is " (rtos (vla-get-Length T_Object) (getvar "LUNITS") 6))) ) (princ "\n ** Nothing selected or not a polyline.") ) (princ) ) Thx MINMAXLENGHTS.lsp

I can't figure out why when I manually enter the command it doesn't cause a regeneration of the model, but when I run my code, it causes it twice. (defun C:PJ () (get_CurrentState) (setvar "CMDECHO" 0) (setvar "PEDITACCEPT" 1) (COMMAND ".PEDIT" PAUSE "JOIN" "ALL" "" "") (cond ((= (cdr (assoc 70 (entget (entlast)))) 1) (princ (strcat "\nPolyline: CLOSED Vertices: " (itoa (cdr (assoc 90 (entget (entlast))))) "\n"))) ((= (cdr (assoc 70 (entget (entlast)))) 0) (princ "\nPolyline: OPEN\n")) ) (set_CurrentState) (princ) ) It's not super critical that it happens, but it is certainly annoying. Any insight would be much appreciated.

Hai all, i have a lisp that gives me Length and Width of Rectangles that i select into a Table in cad. the table gives me the length and width as per incremental in size (eg:{ 1x2, 1.2x2, 2.1x3 } like wise) i have attached a screenshot of this, and also joins same size rectangle in one cell and shows number as 2. What i need help is to get the table not as incremental values but as i select (1st selection in first cell, 2nd in second cell like that). Please check the Screen shot. i don't know how to change the codes, the lisp is from a friend i got. so please help if possible , thanks in advance.. Please check the image ive uploaded too. the lisp code: (defun rectangle_dims (e / l a b) (setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) e))) (if (and (or (= 1 (logand (cdr (assoc 70 e)) 1)) (equal (car l) (last l) 1e-8) ) (equal (distance (car l) (caddr l)) (distance (cadr l) (cadddr l)) 1e-8) (equal (mapcar '- (cadr l) (car l)) (mapcar '- (caddr l) (cadddr l)) 1e-8) (equal (mapcar '- (caddr l) (cadr l)) (mapcar '- (cadddr l) (car l)) 1e-8) ) (vl-sort (list (distance (car l) (cadr l)) (distance (cadr l) (caddr l))) '<) ) ) (defun C:RECDIMS (/ acObj acDoc space *error* ss e old r p1) (vl-load-com) (setq acObj (vlax-get-acad-object) acDoc (vla-get-activedocument acObj) space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace)) ) (vla-startundomark acDoc) ;;;;;; Error function ;;;;;;;;; (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)) ) (vla-endundomark acDoc) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>")))) (progn (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (if (setq dims (rectangle_dims (entget e))) (if (setq old (vl-some '(lambda (d) (if (equal (list (cadr d) (caddr d)) dims 1e-8) d)) r)) (setq r (subst (cons (1+ (car old)) dims) old r)) (setq r (cons (cons 1 dims) r)) ) ) ) (if (and r (setq p1 (getpoint "\nSpecify table insert point: "))) (insert_table (mapcar '(lambda (a) (list (cadr a) (caddr a) (car a)) ) (vl-sort (vl-sort r '(lambda (a b) (< (caddr a) (caddr b)))) '(lambda (a b) (< (cadr a) (cadr b)))) ) p1 ) ) ) ) (princ) ) ;;The textheight in table depends on cannonscale (defun insert_table (lst pct / tab row col ht i n) (setq ht (/ 2.5 (getvar 'cannoscalevalue)) pct (trans pct 1 0) n (trans '(1 0 0) 1 0 T) tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht)) ) (vlax-put tab 'direction n) (mapcar (function (lambda (rowType) (vla-SetTextStyle tab rowType (getvar 'textstyle)) (vla-SetTextHeight tab rowType ht) ) ) '(2 4 1) ) (vla-put-HorzCellMargin tab (* 0.14 ht)) (vla-put-VertCellMargin tab (* 0.14 ht)) (setq lst (cons '("Width" "Length" "Pcs.") lst)) (setq i 0) (foreach col (apply 'mapcar (cons 'list lst)) (vla-SetColumnWidth tab i (apply 'max (mapcar '(lambda (x) ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht))) (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht))) ) ) col ) ) ) (setq i (1+ i)) ) (setq lst (cons '("RECTANGLES") lst)) (setq row 0) (foreach r lst (setq col 0) (vla-SetRowHeight tab row (* 1.5 ht)) (foreach c r (vla-SetText tab row col (vl-princ-to-string c)) (setq col (1+ col)) ) (setq row (1+ row)) ) ) (princ "\nType RECDIMS to start the command")

I'm having a hard time: I'm creating a middle line in the center of a road route, to verify the distance traveled by trucks. To do this, I create a 3dpolyline by connecting the edges of the path and then create a 3D POLYLINE by clicking on the midpoint of each polyline to draw a median route. As they are many, it is being a complicated job, since I have to click on the midpoint of each one to generate the 3D line that I need. Is there any lisp that can already do this, remembering that it needs to be 3D?

Hi all: I like using Lisps, but don't know how to write code for them. I like this particular lisp created by Mosad Elewa and posted on Cadalyst.com. When trying the lisp on a polyline, it did not work. Seems to only work on a "line". Here's the code: ---------------------------------------------------------------------------------------------------- ;;;CADALYST 02/07 Tip 2180: DIV.LSP Modify Divide © 2007 Mosad Elewa ;DIV.LSP BY MOSAD H. ELEWA (1996) (defun C:DIV () (setq ent (entget (car (entsel "\nSelect object to divide")))) (setq etype (cdr (assoc 0 ent))) (if (eq etype "LINE") (progn (cond ( (setq m (getint "\nNumber of segments")) (setq pt1 (cdr (assoc 10 ent))) (setq pt2 (cdr (assoc 11 ent))) (setq ang (angle pt1 pt2)) (setq dist (distance pt1 pt2)) (setq dd (/ dist m)) (setq pt3 (polar pt1 ang dd)) (setq ang2 (+ ang 1.5708)) (setq pt4 (polar pt3 ang2 (/ dd 4))) (setq ds (distance pt1 pt3)) (command "line" pt3 pt4 "") (setq pt5 (polar pt3 ang2 (/ dd )) (command "move" "l" "" pt4 pt5) (setq d 0) ; (setvar "cmdecho" 0) (command "copy" "l" "" "m" pt1) (repeat (- m 2) (command (polar pt1 ang (setq d (+ d ds))))) (command ""))) )) (if (eq etype "ARC") (progn (setq n (getint "\Number of segments")) (setq ang (cdr (assoc 50 ent))) (setq ang2 (cdr (assoc 51 ent))) (setq ang3 (- ang2 ang)) (setq ang4 (/ (* ang3 180.0) pi)) (setq cp (cdr (assoc 10 ent))) (setq r (cdr (assoc 40 ent))) (setq pt1 (polar cp ang r)) (setq pt2 (polar cp ang (/ r 4))) (setq pt3 (polar cp ang (/ r )) (command "line" cp pt2 "") (command "move" "l" "" pt3 pt1) (command "array" "l" "" "p" cp (+ n 1) ang4 "y") )) (if (eq etype "CIRCLE") (progn (setq n (getint "\Number of segments")) (setq cp (cdr (assoc 10 ent))) (setq r (cdr (assoc 40 ent))) (setq pt1 (polar cp 0 r)) (setq pt2 (polar cp 0 (/ r 4))) (setq pt3 (polar cp 0 (/ r )) (command "line" cp pt2 "") (command "move" "l" "" pt3 pt1) (command "array" "l" "" "p" cp n "360" "y") )) (princ) )[/CODE] -----------------------------------------------------------------------------------------------------

I love Extrim, but it only does one trim at a time. I am looking to trim everything that is selected at once. The pseudocode goes like this: 1. Get selection 2. Filter out everything but closed polylines 3. Ask user if they want to just trim crossing lines, or to delete everything 4. selected on that side of the line. 5. Get a point as the side to extrim on. If inside any selected polyline, get the inside point of each polyline and then trim inside each one (or inside the boundary of any crossing ones). Likewise, if outside of all selected polylines, trim the outside of each one (or outside the boundary of any crossing ones). My main problem is that I have no clue what I'm doing when it comes to dealing with Extrim. The syntax keeps throwing me around. I thought it would be super simple when I started, but because Extrim is a LISP rather than a command, it's got me really confused. I was planning to make use of alanjt's SelectWithinCurve routine to help with deleting non-crossing geometry.

Hi all - I created a lightweight polyline by filleting two straight polylines to create 1 polyline that contains an arc. I would like to convert the arc into a series of straight polylines that mimic the original shape of the arc, while not disturbing the straight parts of the polyline. I found a .lsp routine that does this perfectly, but it only works for the older heavyweight polylines. Can anyone help modify this routine so it works for lightweight polylines or provide another suggestion? Id rather not convert to heavyweight, use the routine, and convert back to lightweight. Thanks so much! Here is the code: ;;;Translate plines w/ arcs to plines w/ mult. straight segments for use ;;;with DTM TIN's for contouring. Rounds out pline arcs via a suitable no. ;;;of straight segments. The determiner is based on small angle deflection. ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 5-10-96 ;;; Edited: 10-1-98 ;;; (DEFUN c:plxl (/ found) (SETQ osmod (GETVAR "osmode") fltot 0 incrn 0 ) ;_ end of setq (SETVAR "osmode" 0) (SETQ usrdeg (ureal 1 "" "Deflection angle (< 5 degrees)" (IF usrdeg usrdeg 5.0 ) ;_ end of if ) ;_ end of ureal ) ;_ end of setq (SETQ usrrad (* (/ usrdeg 180.0000) PI)) (SETQ pliness (SSGET '((0 . "POLYLINE")))) (IF pliness (PROGN (COMMAND ".undo" "m") (SETQ plinesslen (SSLENGTH pliness) sscount 0 ) ;_ end of setq (WHILE (< sscount plinesslen) (SETQ currpline (SSNAME pliness sscount)) (SETQ plent (ENTGET currpline)) (SETQ plvert (ENTGET (ENTNEXT (CDAR plent)))) (PROGN (ENTMAKE (LIST (ASSOC 0 plent) (ASSOC 8 plent) (ASSOC 66 plent) (ASSOC 10 plent) (ASSOC 70 plvert) ) ;_ end of list ) ;_ end of entmake (ENTMAKE (LIST (ASSOC 0 plvert) (ASSOC 10 plvert) ) ;_ end of list ) ;_ end of entmake ;;;----repeat this until the end of the polyline (WHILE (/= (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDAR plvert))))) "SEQEND" ) ;_ end of /= ;;;------if it begins an arc segment (IF (/= (CDR (ASSOC 42 plvert)) 0) ;;;--------do this (PROGN (SETQ found T) (SETQ plnvert (ENTGET (ENTNEXT (CDAR plvert)))) (SETQ strt40 (CDR (ASSOC 40 plvert))) (SETQ end41 (CDR (ASSOC 41 plvert))) (SETQ fpt1 (CDR (ASSOC 10 plvert))) (SETQ fpt2 (CDR (ASSOC 10 plnvert))) (SETQ chrdl (DISTANCE fpt1 fpt2)) (SETQ theta (ATAN (CDR (ASSOC 42 plvert)))) (SETQ psi (- (/ PI 2) (ABS theta))) (SETQ phi (* (ABS theta) 4)) (SETQ chang (ANGLE fpt1 fpt2)) (SETQ arcr (ABS (/ (* (DISTANCE fpt1 fpt2) (SIN psi)) (* 2 (COS theta) (SIN (* 2 theta))) ) ;_ end of / ) ;_ end of abs ) ;_ end of setq (SETQ arcc (IF (> theta 0) (POLAR fpt1 (+ (- chang theta) psi) arcr) (POLAR fpt1 (- (- chang theta) psi) arcr) ) ;_ end of if ) ;_ end of setq (SETQ fenl (* phi arcr) count (1+ (FIX (/ phi usrrad))) plwinc (/ (- strt40 end41) count) plwe (+ strt40 plwinc) incra (/ phi count) incrn 0 initang (ANGLE arcc fpt1) ) ;_ end of setq (WHILE (> count 0) (SETQ incrn (1+ incrn)) (SETQ plwb plwe plwe (- plwe plwinc) ) ;_ end of setq (IF (< theta 0) (SETQ fpt4 (POLAR arcc (- initang (* incrn incra)) arcr) ) ;_ end of setq (SETQ fpt4 (POLAR arcc (+ initang (* incrn incra)) arcr) ) ;_ end of setq ) ;_ end of if (PROGN (ENTMAKE (LIST (CONS 0 "VERTEX") (ASSOC 8 plvert) (CONS 10 fpt4) ) ;_ end of list ) ;_ end of entmake (GRDRAW fpt1 fpt4 -1) ) ;_ end of progn (SETQ fpt1 fpt4 count (1- count) ) ;_ end of setq ) ;_ end of while (SETQ plvert (ENTGET (ENTNEXT (CDAR plvert)))) ) ;_ end of progn ;;;--------or else it begins a line segment so do this (PROGN (SETQ fpt1 (CDR (ASSOC 10 plvert))) (SETQ fpt2 (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDAR plvert))))) ) ;_ end of setq (SETQ fenl (DISTANCE fpt1 fpt2)) (ENTMAKE (LIST (CONS 0 "VERTEX") (ASSOC 8 plvert) (CONS 10 fpt2) ) ;_ end of list ) ;_ end of entmake (GRDRAW fpt1 fpt2 -1) (SETQ fpt1 fpt2) (SETQ plvert (ENTGET (ENTNEXT (CDAR plvert)))) ) ;_ end of progn ) ;_ end of if ) ;_ end of while (IF found (PROGN (ENTMAKE (LIST (CONS 0 "SEQEND") ) ;_ end of list ) ;_ end of entmake (ENTDEL currpline) ) ;_ end of progn (PROGN (ENTMAKE) (COMMAND ".redraw") (PRINC "\nPolyline contains no arcs. ") ) ;_ end of progn ) ;_ end of if ) ;_ end of progn (SETQ sscount (1+ sscount)) ) ;_ end of WHILE ) ;_ end of progn ) ;_ end of if (PRINC) ) ;_ end of defun ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ***Don't add text below the comment!***|; I also had to add this into AutoCAD to get it to work: ;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications. This credit must accompany all copies of this function. ; ;* UREAL User interface real function ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. ;* MSG is the prompt string, to which a default real is added as <DEF> (nil ;* for none), and a : is added. ;* (defun ureal (bit kwd msg def / inp) (if def (setq msg (strcat "\n" msg " <" (rtos def 2) ">: ") bit (* 2 (fix (/ bit 2))) ) (setq msg (strcat "\n" msg ": ")) );if (initget bit kwd) (setq inp (getreal msg)) (if inp inp def) );defun ;* (princ) ;*

Hello, I'm working on a project that requires a lot of specific polyline stationing. I'm using Map 3D 2008 with modules for Surveying/Planning adjusted for standards in my country, and among all tools I have one for stationing polyline. It works in these steps: - select polyline - starting station (example: 0+000.00) - starting station number (integer value as sufix for labeling stations, example: PR 1, PR 2....) - distance between profiles Result of this can be seen in attached file STATIONIG.dwg, but basicaly I get profile on defined distances and on every vertex. What I need for current project is to label first point, last point and possibly one or two more on click. Example is in attached file SPEC_STATIONING.dwg As you can conclude I can get desired result by stationing polyline with current tools and then deleting excessive stations. However, I have nearly 850 short (up to 150-200 m) polylines, so deleting them would consume big chunk of time. I have found couple lisps for stationing poyline, but none of them fits. Honestly I thought there has to be some lisp to deal this with great detail since this is common operation in planing. I know C3D does this perfectly, but sometimes you need quick solution, not have to deal with alignments and other elements. Stationing line has the following elements (picture below): 1) polyline to be stationed 2) starting station (in meters) 3) station distance format (0+00.00, 0+000.00 ...) 4) station label (prefix, sufix and starting number) 5) left and right line (length) * Items 3,4(prefix and suffix, not starting number) and 5 could be hardcoded, since they would always be the same in every country. Note: angle of stationig line and text should be: - perpendicular to polyline start/end segment on first and and last polyline point - perpendicular to polyline if station is drawn on segment (not vertex) - half of exterior/interior angle on every other vertex I believe this lisp would be useful to a lot of people in surveying/planning. STATIONING.dwg SPEC_STATIONING.dwg

Dear friends, how long I was here!... I need some help, if someone knows any lisp to convert Lines in 3D to 3D Polylines. The goal about it is to do a Pipeline tubes in 3D way. Thanks a lot for any help. CafeJr...

Hello, I recently discovered the potential in acad with lisps, and first of all I want to thank all the people sharing their knowledge (specific thanks to Tharwat and GC gile)! I am completely ignorant regarding what seems like programming here, but I am very willing to try and learn (allready succeeded in changing a parameter in a lisp all by myself!) The facts are: I have lots of closed 2d polylines (or lwpolylines, doesn't really matter because I have learned how to turn my polys into lwpolys). I have to extract their area, layer and coordinates, in a way that each polyline's data can be identified in the resulting file. I started by researching a way to automatically name the polylines, not much luck, so I am determined to enter numbers manually in the hyperlink field for each polyline. I have also found a lisp that extracts hyperlink, layer and area for multiple polys at once, which is a great first step (as a newbie I am not sure if I can post the link here). What now remains is to extract each poly’s coordinates together with its hyperlink. Do you think it is doable to invent a routine and achieve this for many polylines at once? Alternatively I will have to list and copy paste the coords for each polyline separately... for 400 polylines ... and then again in another similar dwg... etc. Sorry for the large thread, I hope I explained properly – and sorry if the answer already exists somewhere, I did my best to find it but didn’t (I did find quite some lisps to export coords, without separation per polyline and without hyperlink. Maybe someone experienced could alter these to include the extra data, but this is not my case…) Many thanks in advance to all the helpfull inlightened people here, Maria

Hopefully I am just unaware of a setting or method for doing this but so far the field command is handy but missing something. Associative updates. When a polyline is drawn and used for calculating the area the field command does a quick job of extracting that info into a field text element. Problem is when that polyline boundary is changed the "field text" that was established previously does not update. Is this even possible or am I S.O.L.?

this lisp convert polyline segments to arcs . work one line for time . i need select 1000 polylines for times. I'm new in autolisp and i do know what change in the code : (defun c:lwsegs2arced ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n ) (vl-load-com) (defun massoclst ( key lst ) (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst))))) ) (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst ) (setq k (length (setq slst (member (assoc key lst) lst)))) (setq p (- (length lst) k)) (setq j -1) (repeat p (setq plst (cons (nth (setq j (1+ j)) lst) plst)) ) (setq plst (reverse plst)) (setq j -1) (setq m -1) (repeat k (setq j (1+ j)) (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6) (setq m (1+ m)) ) (if (and (not tst) (= n m)) (setq pslst (cons (cons key value) pslst) tst t) (setq pslst (cons (nth j slst) pslst)) ) ) (setq pslst (reverse pslst)) (append plst pslst) ) (defun v^v ( u v ) (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1)) ) (defun unit ( v ) (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v) ) (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p ) (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7)) (progn (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1)))) p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1)))) op (trans o 0 (v^v nor (unit (mapcar '- p2 p1)))) op (list (car op) (cadr op) (caddr p1p)) tp (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0) ) (if (inters p1p p2p op tp nil) (progn (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0)) p ) nil ) ) (progn (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor)))) (setq p (trans pp nor 0)) p ) ) ) (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (vla-startundomark doc) (if (and (setq lw (entsel "\nPick LWPOLYLINE...")) (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE") ) (progn (setq i (fix (vlax-curve-getParamAtPoint (car lw) (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0)) ) ;_ vlax-curve-getParamAtPoint ) ;_ fix p1 (vlax-curve-getPointAtParam (car lw) i) p3 (vlax-curve-getPointAtParam (car lw) (1+ i)) lw (car lw) ) (setq enxb (massoclst 42 enx)) (while (= 5 (car (setq gr (grread t)))) (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw))))) (setq b ((lambda (a) (/ (sin a) (cos a))) (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0) ) ) (setq n -1) (foreach dxf42 enxb (setq n (1+ n)) (if (= n i) (setq enx (nthmassocsubst n 42 b enx)) (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx)) ) ) (entupd (cdr (assoc -1 (entmod enx)))) ) ) (prompt "\n Nothing selected or picked object not a LWPOLYLINE ") ) (vla-endundomark doc) (princ) )

Sample.dwg Hi all, I want to write a program which will export the coordinates of vertices for selected polylines with Object Data which corresponds to each polyline. Please refer to a sample drawing attached with this thread. I am happy with this program to export coordinates ; ---------------------------------------------------------------------- ; (Export LWPOLYLINE Vertices & Points to File) ; Copyright (C) 2000 DotSoft, All Rights Reserved ; Website: http://www.dotsoft.com ; ---------------------------------------------------------------------- ; DISCLAIMER: DotSoft Disclaims any and all liability for any damages ; arising out of the use or operation, or inability to use the software. ; FURTHERMORE, User agrees to hold DotSoft harmless from such claims. ; DotSoft makes no warranty, either expressed or implied, as to the ; fitness of this product for a particular purpose. All materials are ; to be considered ‘as-is’, and use of this software should be ; considered as AT YOUR OWN RISK. ; ---------------------------------------------------------------------- ;;Revised 8/23/07 CAB to report coordinates in current UCS (defun c:ptexport () (setq sset (ssget '((-4 . "<OR")(0 . "POINT") (0 . "LWPOLYLINE")(-4 . "OR>")))) (if sset (progn (setq itm 0 num (sslength sset)) (setq fn (getfiled "Point Export File" "" "txt" 1)) (if (/= fn nil) (progn (setq fh (open fn "w")) (while (< itm num) (setq hnd (ssname sset itm)) (setq ent (entget hnd)) (setq obj (cdr (assoc 0 ent))) (cond ((= obj "POINT") (setq pnt (cdr (assoc 10 ent))) (setq pnt (trans pnt 0 1));;**CAB (princ (strcat (rtos (car pnt) 2 "," (rtos (cadr pnt) 2 "," (rtos (caddr pnt) 2 ) fh) (princ "\n" fh) ) ((= obj "LWPOLYLINE") (if (= (cdr (assoc 38 ent)) nil) (setq elv 0.0) (setq elv (cdr (assoc 38 ent))) ) (foreach rec ent (if (= (car rec) 10) (progn (setq pnt (cdr rec)) (setq pnt (trans pnt 0 1));;**CAB (princ (strcat (rtos (car pnt) 2 "," (rtos (cadr pnt) 2 "," (rtos elv 2 ) fh) (princ "\n" fh) ) ) ) ) (t nil) ) (setq itm (1+ itm)) ) (close fh) ) ) ) ) (princ) ) (princ "\nPoint Export loaded, type PTEXPORT to run.") (princ) Now I want to add Object data such as: 1. For polylines on 'LVCable' layer - CSAMetric, Conductor, FeederNo, NoOfCores 2. For polylines on other layers - CSABlue, CSANeutral, CSARed, CSAYellow, FeederNo Thank you Best wishes, Jes G Sample.dwg

sample_MPoly2.dwg Hi all, I have six polylines, one of them is closed. I need to create vertices on a closed polyline. The sample drawing is attached. The vertex coordinates to be created are the coordinates of first vertex of other polylines. So far I only managed to store the coordinate of starting vertex of one polyline. (vl-load-com) (setq s1 (car (entsel))) (setq pl (vlax-ename->vla-object s1)) (defun vlax-list->2D-point (lst) (if lst (cons (list (car lst) (cadr lst)) (vlax-list->2D-point (cddr lst))))) (setq vertCoord(vlax-list->2D-point (vlax-get pl 'Coordinates))) (setq vertStart (car vertCoord)) Appreciate your help. Thank you

Hi all, I am trying to write a LISP routine to list all the vertices of selected MPolygon. I have one MPolygon and 5 polylines. The sample drawing is attached. Basically, I want the program to create vertices on the MPolygon where the polylines touch the MPolygon (meaning there is no gap between them) and store the coordinates of all the vertices into a variable. Thank you Best wishes, Jes G sample_MPoly.dwg

Hi all, I found this LISP routine by Tony Hotchkiss from here. If I understood this correct, it works with LWPolyline, Polyline and Point. For some reason it does not work will all polylines on my drawing. The sample drawing is provided below and attached with this thread https://drive.google.com/file/d/1bLurrxbnH6c9Fee5L4qIc0okwdVU0b9W/view?usp=sharing (defun vert (/ filterlist vla-obj-list lwlist 2dlist ptlist vlist1 vlist2 vlist3 ) (vl-load-com) (setq filterlist (make-filter) vla-obj-list (get-objects filterlist) lwlist (nth 0 vla-obj-list) 2dlist (nth 1 vla-obj-list) ptlist (nth 2 vla-obj-list) vlist1 nil vlist2 nil vlist3 nil ) ;_ end-of setq (if lwlist (setq vlist1 (make-list lwlist 2)) ) ;_ end of if (if 2dlist (setq vlist2 (make-list 2dlist 3)) ) ;_ end of if (if ptlist (setq vlist3 (make-list ptlist 3)) ) ;_ end of if (write-text vlist1 vlist2 vlist3) (princ) ) ;_ end of vert (defun make-list (p-list n / i vlist obj coords ca j x y z xy) (setq i (- 1) vlist nil ) ;_ end of setq (repeat (length p-list) (setq obj (nth (setq i (1+ i)) p-list) coords (vlax-get-property obj "coordinates") ca (vlax-variant-value coords) j (- 1) ) ;_ end-of setq (repeat (/ (length (vlax-safearray->list ca)) n) (setq x (vlax-safearray-get-element ca (setq j (1+ j)))) (setq y (vlax-safearray-get-element ca (setq j (1+ j)))) (if (= n 2) (setq xy (list x y)) (progn (setq z (vlax-safearray-get-element ca (setq j (1+ j)))) (setq xy (list x y z)) ) ;_ end of progn ) ;_ end of if (setq vlist (append vlist (list xy))) ) ;_ end-of repeat ) ;_ end-of repeat ) ;_ end-of make-list (defun make-filter (/ filter) (setq filter '((-4 . "<OR") (0 . "LWPOLYLINE") (0 . "POLYLINE") (0 . "POINT") (-4 . "OR>") ) ) ;_ end of setq ) ;_ end of make-filter (defun get-objects (filter / ss k lwp-list 2dp-list pt-list no-ent obj pl 2d pt ) (setq no-ent 1) (while no-ent (setq ss (ssget filter) k (- 1) lwp-list nil 2dp-list nil pt-list nil obj nil pl "AcDbPolyline" 2d "AcDb2dPolyline" pt "AcDbPoint" ) ;_ end-of setq (if ss (progn (setq no-ent nil) (repeat (sslength ss) (setq ent (ssname ss (setq k (1+ k))) obj (vlax-ename->vla-object ent) ) ;_ end-of setq (cond ((= (vlax-get-property obj "ObjectName") pl) (setq lwp-list (append lwp-list (list obj))) ) ((= (vlax-get-property obj "ObjectName") 2d) (setq 2dp-list (append 2dp-list (list obj))) ) ((= (vlax-get-property obj "ObjectName") pt) (setq pt-list (append pt-list (list obj))) ) ) ;_ end-of cond ) ;_ end-of repeat ) ;_ end-of progn (prompt "\nNo polylines or points selected, try again.") ) ;_ end-of if ) ;_ end-of while (list lwp-list 2dp-list pt-list) ) ;_ end-of get-objects (defun write-text (vl1 vl2 vl3) (setq fn (getfiled "Text File" "" "txt" 1)) (setq f (close (open fn "w"))) (setq msg "Points from LW-Polylines") (do-points fn vl1 msg 2) (setq msg "Points from 2d-Polylines") (do-points fn vl2 msg 3) (setq msg "Points from Point entities") (do-points fn vl3 msg 3) (princ) ) ;_ end of write-text (defun do-points (fn vl msg n) (setq f (open fn "a")) (write-line msg f) (write-line " x, y, z" f) (write-line "" f) (foreach point vl (setq x (nth 0 point) y (nth 1 point) ) ;_ end of setq (if (= n 2) (setq str (strcat (rtos x) "," (rtos y))) (progn (setq z (nth 2 point)) (setq str (strcat (rtos x) "," (rtos y) "," (rtos z))) ) ;_ end of progn ) ;_ end of if (write-line str f) ) ;_ end of foreach (setq f (close f)) (princ) ) ;_ end of defun (defun c:pts () (vert) (princ) ) ;_ end-of defun (prompt "PLIST.LSP by Tony Hotchkiss - enter PTS to start ") I am new in AutoLISP so I would appreciate if you could suggest me how this code can be modified to export all the coordinates of polylines for my sample drawing. Or maybe my drawing can be modified using another LISP routine. In addition, I want the program to output two files. The first file would be the XY coordinates of all points of the polylines with number (kind of identification). For example, The second file would include the points and distances between them. For example, Thank you Best wishes, Jes G Sample.dwg

Hello there, Merry Christmas! I am new in LISP and I don't know where to start from. For clarity, please refer to the snapshot provided. I am not quite familiar with AutoCAD terminology though, but I'll try to explain my problem clear. Basically, we have polylines and points having their coordinates (these small blue rectangulars). What we need to do is: Find the closest on the polyline from the "blue rectangular" Create the vertex on THAT point Export to Excel files the following parameters: number, Coordinates of each vertex, distances between them, '1' if the line contains newly-created vertex The output files are expected to look like: 1. XY_Coords.xls: Node X Y 1 359.898 163.788 2 358.514 164.124 3 358.423 164.131 4 358.354 164.119 5 358.26 164.07 6 358.198 164.005 7 358.153 163.91 8 355.136 152.963 9 354.962 152.691 2. Lines.xls NodeA NodeB Distance Load 1 2 1.424202233 0 2 3 0.091268834 0 3 4 0.070035705 1 4 5 0.106004717 0 5 6 0.089827613 0 6 7 0.10511898 0 7 8 11.35513531 1 8 9 0.322893171 0 9 10 0.22220036 0 10 11 0.299247389 0 Please ask questions if you need some clarifications. Your help is greatly appreciated. Thank you Best wishes, Jes G https://ibb.co/mgpUaR

Hello, there, I am trying to find a LISP routine which will find the closest point on a polyline from a selected block reference. This routine finds the closest distance between two objects by selecting both objects, but it does not seem to work with block reference. After it finds the closest point, how to create a new vertex on that point? Thank you in advance Best wishes, Jes G

Hello, I'm using Lee Mac cad lisp program "PolyInfo V 1.3." for exporting polylines vertex coordinates. But for full work joy I need some modifications. URL for program: http://www.lee-mac.com/polyinfo.html URL for code: http://www.lee-mac.com/lisp/html/PolyInfoV1-3.html As you saw the program exports a lot of information about the polyline. So i want to modify the code that will export just polyline start vertex points x and y coords in two columns ( my cad version information exports to txt file ). The result should look like this: ________________________________ Polyline starts points x 649542.45 649542.35 649542.28 Polyline starts points y 495232.54 495232.23 495232.41 ________________________________ Can someone help to figure out which part of code I must to modify to get the result i want? Please.

(Here is a link to the original post I am referencing) Hi Guys, I found this awesome lisp by Renderman/Black Box and I have run it a few times and it worked great those times. Then I tried to run it to convert maybe 20 wipeouts at once and a bunch of them disappeared. I would really like to be able to use this one time once I finish drawing all the wipeouts and not after everyone, but I also don't want to risk some failing to convert and having to redraw a bunch of them. Does anyone see anything that would cause these errors? ;;;--------------------------------------------------------------------; ;;; c:WIPEOUT->REGION ;;; Courtesy of RenderMan, CADTutor.net ;;;--------------------------------------------------------------------; ;;; Description: ;;; Convert all wipeouts within a given drawing to regions. ;;;--------------------------------------------------------------------; ;;; Exit function: (defun WIPEOUT->REGION:Exit (msg) (cond ((not msg)) ; Normal exit ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit) ((princ (strcat "\n <!> Error: " msg " <!> ")))) ; Fatal error, display it (WIPEOUT->REGION:Quit)) ;;;--------------------------------------------------------------------; ;;; Quit function: (defun WIPEOUT->REGION:Quit () (setvar 'cmdecho *oldCmdecho*) (setq *oldCmdecho* nil) (setq *error* *oldError* *oldError* nil) (vla-endundomark *activeDoc*) (princ)) ;;;--------------------------------------------------------------------; ;;; Main function: (defun c:WIPEOUT->REGION (/ ss) (vl-load-com) (vla-startundomark (cond (*activeDoc*) ((setq *activeDoc* (vla-get-activedocument (vlax-get-acad-object)))))) ;; Error checking (setq *oldError* *error* *error* WIPEOUT->REGION:Exit) (setq *oldCmdecho* (getvar 'cmdecho)) (setvar 'cmdecho 0) ;; Main code (if (and (setq ss (ssget "_x" '((0 . "WIPEOUT")))) (setq ss (ssget "_x"))) ((lambda (i / e v visList wipList mn mx c) (while (setq e (ssname ss (setq i (1+ i)))) (if (/= "WIPEOUT" (strcase (cdr (assoc 0 (entget e))))) (progn (vla-put-visible (setq v (vlax-ename->vla-object e)) :vlax-false) (setq visList (cons v visList))) (setq wipList (cons e wipList)))) (foreach w wipList (vla-getboundingbox (setq v (vlax-ename->vla-object w)) 'mn 'mx) (setq c (mapcar '* (mapcar '+ (setq mn (vlax-safearray->list mn)) (setq mx (vlax-safearray->list mx))) '(0.5 0.5 0.5))) (vl-cmdf "._boundary" c "") (vl-cmdf "._matchprop" w (entlast) "") (vl-cmdf "._region" "") (vla-delete v)) (foreach o visList (vla-put-visible o :vlax-true))) -1) (prompt "\n <!> No Wipeouts Detected in Currect Drawing <!> ")) (WIPEOUT->REGION:Quit))

I am hoping this will be a simple fix, but searching for the answer has turned up nothing. If I offset a self-intersecting polyline, it trims the offset anywhere that it crosses the original polyline. I am looking for a way for the offset to continue through self intersections untrimmed. My hope is that the self-trimming is a "feature", and that there is a way to turn it off, perhaps through a system variable or something. If not, the only way I can think to fix it is to write my own custom offset which doesn't sound very efficient. ps. Although I'm posting this in the general autocad area, I'm open to solutions that require autolisp. The reason I'm looking for this answer is to be used in an automated routine once I get past this hurdle. ***edit*** I found this thread , but it doesn't give a solution (aside from "use an ancient version on AutoCAD").

Dear folks, There is an idea to get things easier in my workflow but I need check if it is possible or not. There are over 100 closed polyline objects on the model and each has a unique ID written in its Hyperlink value (like X_D_YYYY) And each of these polylines has a block placed in the enclosing area with an attribute. My aim is to get the Hyperlink from enclosing polyline and populate the block attribute with that value. You may find an example as DWG at the attachment. Regards. get-Enclosing-polyline-data.dwg

Hi, I converted a pdf file into dwg. In this new file a point has become a group of 2D polyline and not a sigle entity. This conversion is necessary because I have to work in autocad. My problem is that I have to search in this dwg all of this "points" and write a text next to. Is possible to write a VBA program for autocad able to do this? If the point was a single point, it wouldn't be a problem, but in this case...I dont' know!

Hi, Can anyone help me to write a lisp function to sort the points (assume the intersection points) on a polyline? With my code, I have a polyline object and a set of intersection points on it. I need to calculate the cumulative distance between those points and vertex points consecutively. Thanks,