All Activity

This is very useful. Is there a version of this where I can only select some blocks and not all of them?

Ok its simple to use vpoint to set your view angles, code is part of a view choice lisp. (if (= look "R")(command-s "-vpoint" "1,0,0")) (if (= look "L")(command-s "-vpoint" "-1,0,0")) (if (= look "F")(command-s "-vpoint" "0,-1,0")) (if (= look "B")(command-s "-vpoint" "0,1,0")) (if (= look "P")(command-s "-vpoint" "0,0,1")) (if (= look "3")(command "_.vpoint" "-1,-1,1")) If you want auto 3 viewports then you need to ask what scale and pick say a point in model so the views can be based around that point. I would use a layout with a title block.

I like using foreach to step thought a selection set or if you need the vla-object (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) ) (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) )

Also you must realize that if two polylines crosses the intersection point is not necessarily a node. ymg

The original drawing is attached with my post as AStar Test.dwg. Start point is upper left. ymg astar test.dwg

It's difficult to know what's happening there without the original drawing and without knowing the starting and ending points. I reproduced that drawing from your image and ran the code without any problems. But perhaps I'm wrong. PS: Anyway, try your code on this drawing (mine will return the same result because it only speeds up the process). YMG3.dwg I've left a yellow line on a different layer from the rest so that it's outside the selection set, and the start and end points are marked with little circles.

Never tried the dict trick to accelerate the retrieval but it seems a good idea. However as of your last edited code the path found is erroneous. See the attached image.

In the 1970s, disco music became a cultural and fashion phenomenon with clubs, disco balls, and John Travolta’s iconic dance moves in Saturday Night Fever. What does this have to do with AutoCAD you may ask? Well, have you ever dragged your mouse across a drawing, and the objects below it lit up like you’re in a disco? Rolling over text, hatches, tables, and groups may light up like it’s to a dance beat, too. Perhaps you’re a bit like me, and while you can appreciate the visual stimulus, you’d rather just get to the point. Today, our feature is called Selection Preview, and, like many AutoCAD features, you can control how it works. Selection Preview Settings The first step, of course, is getting there. It starts with the Options dialog. Get there in your favorite manner – mine is to right-click anywhere in the drawing editor (with no objects selected) and select Options from the pop-up dialog. Then, in the Options dialog, click on the Select tab as shown in the image above. Finally, you’ll want to focus on the Preview settings in the bottom right. Now that you’re where you need to be, let’s see what some of our options are. The first two are directly responsible for our rollover scenario, and one is part of the things I always change when I get an upgrade. We can immediately stop the disco lights when rolling over things with no command active. Uncheck the second entry. That alone will be a big change for you. Personally, I like to have only selection preview enabled when I have a command active. You can also control what kinds of objects are lit up like a disco dance floor when they are previewed. Click on the Visual Effect Settings… button, and you’ll get the following dialog. We want to focus our attention on the right side. This is one of the more unusual dialogs in AutoCAD, as you are selecting an object type to exclude, instead of one to include. Of course, those unchecked are included, but I think you get my meaning. By default, objects on locked layers and Xrefs are excluded from preview. If you’d prefer to see them previewed, uncheck them here. Back to our scenario, this is where you can tell AutoCAD not to preview Tables, Groups, Mtext, or Hatches. Again, you’re excluding things here, so, for example, if you never want to see Hatches preview, whether you’re in a command or not, check it here. Click OK to save and exit, and do the same for the main Options dialog. Moving Forward One of my favorite non-disco bands of that era led a song with the lyrics “Don’t look now, but here come the 80’s.” Not exactly a good way to make a song timeless, but hey, at least I remember it 45 years later. By that time, though, the disco age was coming to a close, culminating in a 1979 “Disco Demolition Night” event at a Chicago White Sox home double-header, which quickly devolved into a riot of fans burning disco records. The good news for you is that you can keep AutoCAD from looking like a disco dance floor and more like a streamlined, fast CAD program. It’s just a matter of knowing where to go and what to adjust. When you do, those polyester suits, gold chains, and slicked back hair will stay in the disco era where they belong. More Tuesday Tips Check out our whole Tuesday Tips series for ideas on how to make AutoCAD work for you. The post Stayin’ Alive with Selection Preview in AutoCAD: Tuesday Tips With Frank appeared first on AutoCAD Blog. View the full article

Thank you.

Hello all: I use a code that generates 3 viewports I would like the chain to be able to generate them in this way that the second viewport is a side view and the third viewport, front view but that in the second and third viewport the UCS is aligned to the view as in the second image If there's any way, I'd appreciate your advice or comments here my code (DEFUN C:V3 () (command "_MODEL" "_-vports" "3" "l" "'_.zoom" "_e" "_-VIEW" "_SWISO")) thanks

The simplest way is when making alignments in CIV3D do not answer Yes to delete pline. You can get the midpoint of a pline very easy its a point at 1/2 the length of the pline. two VL functions. You should be able to add that point then to the alignment. This is get a point at mid point of a pline. (setq obj (vlax-ename->vla-object (car (entsel "\nPick pline ")))) (setq len (/ (vlax-get obj 'length) 2.0)) (setq pt (vlax-curve-getpointatdist obj len))

it should be calculate from north=0 clockwise.

I would like to label the midpoint of an alignment that has multiple segments. Anyone have ideas on this?

My intention was to make lisp more accessible by having some functions already set up and allow user to play with it. Since its open source - I am hoping people with contribute but I am slightly doubtful if people will be encourage to contribute since github is not a thing civil engineers are used to.

In a situation such as this... Can I lock these values so that they cannot be changed? When placing a sketch on another object, I'm not sure how to move/adjust everything so that it is both where and the size I want. if I change one value, the other changes too... Noob. Revit 2026

I think the problem is angle apparently is always calculates from East = 0 regardless of "ANGDIR" or "ANGBASE" New current angle for ANGBASE <0>: : (angle (getpoint)(getpoint)) 0.547902990129444 : ANGBASE New current angle for ANGBASE <0>: 90 : (angle (getpoint)(getpoint)) 0.547902990129444

Good day... Simply change in the code: (if (eq (getkword "\nResult in [Bearing/Degrees]?<Bearing>: ") "Degrees") (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2)) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 0.5) 4 3 2 2)) ) to (if (eq (getkword "\nResult in [Bearing/Degrees]?<Bearing>: ") "Degrees") (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 3 2)) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 0.5) 4 3 3 2)) )

Good day.. (vl-load-com) (defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o) (setq n (/ (cadr (getvar "screensize")) 5.0)) (setq pt (osnap pt-i str-md)) (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o)) (repeat 2 (setq rap (/ (getvar "viewsize") n) pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt5 (list (car pt) (- (cadr pt) rap) (caddr pt)) pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt)) pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt)) pt8 (list (- (car pt) rap) (cadr pt) (caddr pt)) pt56 (polar pt (- (/ pi 4.0)) rap) pt67 (polar pt (/ pi 4.0) rap) pt78 (polar pt (- pi (/ pi 4.0)) rap) pt85 (polar pt (+ pi (/ pi 4.0)) rap) n (- n 16) ) (if (equal (osnap pt-i md) pt) (setq one_o T)) (cond ((and (eq "_end" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1) ) ((and (eq "_mid" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1) ) ((and (eq "_cen" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt5 pt7 7) (grdraw pt6 pt8 7) ) ((and (eq "_nod" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_qua" md) one_o) (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1) ) ((and (eq "_int" md) one_o) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_ins" md) one_o) (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1) ) ((and (eq "_per" md) one_o) (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1) ) ((and (eq "_tan" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt3 pt4 1) ) ((and (eq "_nea" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1) ) ) ) (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0)) ) ) (defun c:LBB ( / l_var AcDoc Space nw_style nw_obj o mod pt1 pt2 pt key pt alpha len_l m_pt val_txt) (setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE"))) (initget "Bearing Degrees") (if (eq (getkword "\nResult in [Bearing/Degrees]?<Bearing>: ") "Degrees") (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2)) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 0.5) 4 3 2 2)) ) (setvar "TEXTSIZE" (* (getvar "VIEWSIZE") 0.015)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "STYLE" "BEARING")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "BEARING")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 0.0 1.0 0.0) ) ) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point '(0.0 0.0 0.0)) 0.0 "" ) ) (setq o (getvar "osmode")) (if (or (zerop o) (eq (boole 1 o 16384) 16384)) (setq mod "_none") (progn (setq mod "") (mapcar '(lambda (xi xs) (if (not (zerop (boole 1 o xi))) (if (zerop (strlen mod)) (setq mod (strcat mod xs)) (setq mod (strcat mod "," xs)) ) ) ) '(1 2 4 8 16 32 64 128 256 512) '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea") ) ) ) (initget 1) (setq pt1 (getpoint "\nPick base point: ") pt2 pt1 ) (while (equal pt2 pt1) (setq pt2 ((lambda ( / key alpha len_l m_pt) (princ "\nPick other point: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (if (and (/= mod "_none") (osnap (cadr key) mod)) (progn (gr-osmode (cadr key) mod) (setq pt (osnap (cadr key) mod)) ) (setq pt (cadr key)) ) (setq alpha (angle pt1 pt) len_l (distance pt1 pt) m_pt (mapcar '* (mapcar '+ pt1 pt) '(0.5 0.5 0.5)) val_txt (vl-string-subst "%%d" "d" (strcat (angtos (- (/ pi 2) alpha) 4 3) "\\P " (rtos len_l) " m")) ) (grdraw pt1 pt 7) (if (and (> alpha (* pi 0.5)) (<= alpha (* pi 1.5))) (setq alpha (+ alpha pi)) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'TextString 'Color) (list 5 (getvar "TEXTSIZE") 5 m_pt "BEARING" (getvar "CLAYER") alpha val_txt 2) ) ) ) ) (redraw) (cadr key) )) ) ) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt))) (vla-endundomark AcDoc) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var) (prin1) ) can you change the two decimal digit into three decimal digits of a distance. thanks.

Hi I've attached a small revision of @ymg3's excellent code that further improves speed. Tested on this drawing (3200 polylines) Ax.dwg ;; Pathfinding with the A* algorithm by ymg 22/07/2024 ; ;; ; ;; Revised a prog by HELMUT SCHRÖDER - heschr@gmx.de - 2014-09-14 ; ;; found at Cadtutor.net ; ;; ; ;; Kept the same format for edges list but added lines as valid choice ; ;; Format: (((x1 y1) (x2 y2)) (((x2 y2) (x3 y3))....(xn yn))) ; ;; ; ;; The user is asked to pick a start and an endpoint. ; ;; The program will find the shortest path in a network of connected ; ;; polylines and/or lines and draw a new polyline representing the result. ; ;; ; ;; Two lists of nodes openlst and closelst are created from the above ; ;; mentionned edges list. The format of a node list is: ; ;; (((Point) (Prev Point) Cumulated_Distance Estimated_Total_Distance)...) ; ;; ; ;; Main change from origina are: ; ;; - cons the list instead of append ; ;; - vl-sort the openlist instead of the quicksort ; ;; - Replaced and renamed some vars and subroutine. ; ;; - Added fuzz 1e-4 to all points comparison ; ;; - Change the get_path function ; ;; - Added line as possible edges ; ;; - Added an error handler ; ;; - Added a timer to the search portion of the program ; ;; ; ;; The above changes amounted to an acceleration of about 4x from the ; ;; original program. ; ;; : ;; If you compile this program to a .fas you'll get more than 10x faster. ; ;; ; ;| Added or revised code by GLAVCVS (january 2026) -All set are grouped into one -An associative sparse matrix cell->handles is created for faster cell querying (using new 'addToDict' and 'getCell' functions) -The "edges" list is replaced with the local search retourned by 'getCell' T E S T S ===== fas: 4-5 x faster than previous fas lsp: 7-8 x faster than previous lsp |; (defun c:A* (/ sspl i edges startp endp openlst closelst found acdoc Edgelay Pathlay Pathcol Pathlwt lstClvs ) (vl-load-com) ; Changes values of following 4 global variables to suit your need. ; (setq Edgelay "0" Pathlay "0" Pathcol 1 ; 1=Red 2=Yellow etc. ; Pathlwt 70 ; lineweight for path 0.7mm ; ) (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ) (set_errhandler '("CLAYER" "OSMODE" "CMDECHO")) (setvar 'CMDECHO 0) (setvar 'OSMODE 1) ;;; (if (setq ;;; ssp (ssget '"X" (list (cons 0 "LWPOLYLINE") (cons 8 Edgelay))) ;;; ) ;;; (foreach en (mapcar (function cadr) (ssnamex ssp)) ;;; (addToDict en) ;;; (setq edges (append edges (mk_edge (listpol2d en)))) ;;; ) ;;; nil ;;; ) ;;; ;;; (if (setq ssl (ssget '"X" (list (cons 0 "LINE") (cons 8 Edgelay)))) ;;; (foreach en (mapcar (function cadr) (ssnamex ssl)) ;;; (setq edges (cons (list (butlast (vlax-curve-getstartpoint en)) ;;; (butlast (vlax-curve-getendpoint en)) ;;; ) ;;; edges ;;; ) ;;; ) ;;; ) ;;; ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;ADDED by GLAVCVS (if (setq sspl (ssget "X" (list '(0 . "*LINE") (cons 8 EdgeLay)))) (foreach en (mapcar (function cadr) (ssnamex sspl)) (addToDict en) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq startp (butlast (getpoint "\nPick Start Point: ")) ; Startpoint - reduced to 2D ; endp (butlast (getpoint "\nPick End Point: ")) ; Endpoint - reduced to 2D ; openlst (list (list startp '(0 0) 0.0 (distance startp endp))) ; Add starting node to openlst ; ) (vla-startundomark acdoc) (setq ti (getvar 'MILLISECS)) (while (and openlst (not found)) (setq node (car openlst)) (if (equal (car node) endp 1e-4) (setq found T closelst (cons node closelst) ) (setq closelst (cons node closelst) openlst (upd_openlst edges node endp (cdr openlst) closelst) ) ) ) (if found (mk_lwp (get_path closelst)) (alert "No path was found") ) (princ (strcat "\nExecution time:" (itoa (- (getvar 'MILLISECS) ti)) " milliseconds." ) ) (*error* nil) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;ADDED by GLAVCVS ;;;Create dictionary (defun addToDict (en / p1 p2 id clv) (setq p1 (vlax-curve-getStartPoint en) p2 (vlax-curve-getEndPoint en) id (cdr (assoc 5 (entget en))) ) (foreach p (list p1 p2) (if (setq val (assoc (setq clv (strcat (itoa (fix (car p))) "-" (itoa (fix (cadr p))))) lstClvs)) (setq lstClvs (subst (append val (list id)) val lstClvs)) (setq lstClvs (cons (list clv id) lstClvs)) ) ) ) ;;;return list cell (defun getCell (pt / clv v lr) (if (setq val (assoc (setq clv (strcat (itoa (fix (car pt))) "-" (itoa (fix (cadr pt))))) lstClvs)) (foreach e (cdr val) (setq lr (cons (list (butlast (vlax-curve-getStartPoint (handent e))) (butlast (vlax-curve-getEndPoint (handent e)))) lr)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ; ;; upd_openlst ; ;; ; ;; Each node of the openlst is passed to this sub and we scan the edges list ; ;; to find the corresponding edges. Then both points of the edges are tested ; ;; for equality to the nodes. The fixed cost (distance) is updated and so is ; ;; the estimated total distance. Updates are first put in a temporary node. ; ;; ; ;; We then proceed to test if the temp variable is already in the closelst ; ;; and proceed to the next edge. ; ;; ; ;; If temp is true and temp is not in closelst we go to the recursive sub ; ;; in_openlst which adjust the values and return the updated openlst : ;; ; ;; Upon return we sort the openlst on smallest estimated distance ; ;; and return the openlst to the main routine ; ;; ; (defun upd_openlst (edges node endp openlst closelst / lEdges edge pt fcost p1 p2 d temp) (setq pt (car node) fcost (caddr node) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;added By GLAVCVS (setq lEdges (getCell pt)) (foreach edge lEdges (setq p1 (car edge) p2 (cadr edge) d (distance p1 p2) temp nil ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (while edges ;;; (setq p1 (caar edges) ;;; p2 (cadar edges) ;;; edges (cdr edges) ;;; d (distance p1 p2) ;;; temp nil ;;; ) ;Testing both points of an edge and building a temporary node ; (cond ((equal pt p1 1e-4) (setq temp (list p2 p1 (+ fcost d) (+ fcost d (distance p2 endp)))) ) ((equal pt p2 1e-4) (setq temp (list p1 p2 (+ fcost d) (+ fcost d (distance p1 endp))) ) ) ) (if (and temp (not (memberfuzz (car temp) closelst))) (setq openlst (in_openlst temp openlst)) ) ) ; Keep openlist sorted on smallest Estimated Total Cost ; (vl-sort openlst (function (lambda (a b) (< (cadddr a) (cadddr b)))) ) ) ;in_lst Replaced by memberfuzz ; ;(defun in_lst (pt lst) ; (cond ; ((not lst) nil) ; ((equal pt (caar lst) 1e-4) lst) ; (T (in_lst pt (cdr lst))) ; ) ;) ; returns a new openlst with a double exchanged if cost is lower ; ;; ; (defun in_openlst (node lst) (cond ((not lst) (list node)) ((equal (car node) (caar lst) 1e-4) (if (< (cadddr node) (cadddr (car lst))) (cons node (cdr lst)) lst ) ) (T (cons (car lst) (in_openlst node (cdr lst)))) ) ) (defun in_openlst2 (node lst / s c) (setq s (splitat (caar node) lst) c (cadddr node) ) (cond ((not lst) (list node)) ((not (car s)) (cons node (cadr s))) ((not (cadr s)) (cons node (car s))) (T (if (< (cadddr node) (cadddr (cadr s))) (append (car s) (cons node (cdr s))) lst ) ) ;(T (c ns node lst)) ) ) ;; ; ;; listpol2D 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 2D WCS ; ;; ; ;; Notes: Requires butlast function for 2d points. ; ;; ; (defun listpol2d (en / i lst) (repeat (setq i (fix (1+ (vlax-curve-getEndParam en)))) (setq lst (cons (butlast (vlax-curve-getPointAtParam en (setq i (1- i)))) lst ) ) ) ) ;; ; ;; mk_edge ; ;; ; ;; From a list of consecutives points as supplied by listpol2D, ; ;; Returns a list of edges (((x1 y1)(x2 y2)) ((x2 y2)(x3 y3))...) ; ;; ; (defun mk_edge (lst) (mapcar (function (lambda (a b) (list a b))) lst (cdr lst)) ) ;; ; ;; butlast ; ;; ; ;; Returns a list without the last item ; ;; Used here mainly to change points to 2D ; ;; ; (defun butlast (lst) (reverse (cdr (reverse lst)))) ;; ; ;; get_path ; ;; ; ;; Returns The list of points of shortest path found from closelst. ; ;; ; (defun get_path (lst / path) (setq path (list (caar lst)) prev (cadar lst) lst (cdr lst) ) (while (setq lst (memberfuzz prev lst)) (setq prev (cadar lst) path (cons (caar lst) path) ) ) path ) ;; ; ;; memberfuzz by Gile Chanteau ; ;; ; ;; Modified to work with nodes list ; ;; ; (defun memberfuzz (p lst) (while (and lst (not (equal p (caar lst) 1e-4))) (setq lst (cdr lst)) ) lst ) (defun splitat (p lst / tr) (while (and lst (not (equal p (caar lst) 1e-4))) (setq tr (cons (car lst) tr) lst (cdr lst) ) ) (list (reverse tr) lst) ) (defun truncfuzz (p lst) (if (and lst (not (equal p (caar lst) 1e-4))) (cons (car lst) (truncfuzz p (cdr lst))) ) ) (defun posfuzz (p lst) (- (length lst) (length (memberfuzz p lst))) ) (defun rotleft (lst) (append (cdr lst) (list (car lst)))) (defun rotright (lst) (cons (last lst) (butlast lst))) ;; ; ;; mk_lwp ; ;; ; ;; Draw an lwpolyline given a point list ; ;; ; ;; Will be drawn on layer with color and lineweight defined by Variables ; ;; at beginnung of program. ; ;; ; (defun mk_lwp (pl) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 Pathlay) (cons 62 Pathcol) (cons 90 (length pl)) (cons 70 0) (cons 370 Pathlwt) ) (mapcar (function (lambda (a) (cons 10 a))) pl) ) ) ) ;; Error Handler by Elpanov Evgenyi ; (defun set_errhandler (l) (setq varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) l ) ) ) (defun *error* (msg) (mapcar 'eval varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) ) (princ (strcat "\nError: " msg)) ) (vla-endundomark acdoc) (princ) )

Glad to hear that.

@Kumar1 I'm afraid your not going to get a completely automated solution. It might be possible, I'm not sure, but would take a great deal more code to sort and determine the closest curves. This is something I don't have time to write for you. The solution I gave you works if you select the points, then the curve for each set of dims. I leave it to you to sort out what you want from our examples. P.S. Some of your "points" are actually block references, you should better represent what you want. I am updating the code above to include block references, which will get their insertion point..

dimension to be perpendicular to the lines nearby

Auto dimensiong - Project 1.dwg dimensions to be added as shown in the dwg by selecting multiple points and lines near by.

As I said, this code doesn't work in some special cases. However, in the cases where it does work, it returns surprising results. I've attached a short video to illustrate this. CLG_xple.mp4

I don’t know which program can obtain the best equidistant centerline. But it shouldn’t be very different from what you can achieve with this code. ;********************************************************************** ;************************ G L A V C V S *************************** ;******* COMPLVRES • HORAS • VITAE • SVAE • IN • HOC • CODICE ******* ;***************** VT • TIBI • MAGNO • VSVI • SVIT ******************** ;********************************************************************** (defun c:CLG (/ PI/2 t/2 tol lst e1 e2 l1 l2 lp lp1 lp2 p0 p> p< r1? x m a ap =e1 ee c?1 pp+ c?2 NoEq lps lf lst lt pu *mU *pU *pB lSgmt *sombra* autoInt? ordenaPts interCpta ptEqd asr flanquea afina p>< pp px n lprs lpp lpr1 *pr1 p· ) (defun autoInt? (p1 p2 lp / p0 p1 p2);check if p1-p2 intersects lp list / autointerseccion? (vl-some '(lambda (p) (if p0 (inters p0 (setq p0 p) p1 p2) (not (setq p0 p)))) lp) ) (defun asr (pa pb p1 / ar ang ab); angle right/left ? / define el lado al que se encuentra el otro margen (cond ((< (abs (setq ang (- (setq ar (angle pa pb)) (setq ab (angle pb p1))))) PI) ang) (T (if (<= ar PI) (+ ar (- (* 2 PI) ab)) (- (- ar (* 2 PI)) ab))) ) ) (defun afina (lst / p0 p1 p2 s1 s2 pB lrr lar i pQbro p);this function gets break points on center-line / esta función obtiene los puntos de inflexion de la linea central (if (> (length lst) 3) (progn (foreach p lst (if p0 (if p1 (setq lar (cons (list (abs (asr p0 p1 p)) p0 p1 p (setq i (if i (1+ i) 0))) lar) p0 p1 p1 p) (setq p1 p) ) (setq p0 p) ) ) (setq lar (vl-sort lar '(lambda(a b) (> (car a) (car b)))) i -1) (if (or (= (length lar) 2) (> (car (nth 1 lar)) (* (car (nth 2 lar)) 5.))) (progn (if (= (abs (- (setq p1 (last (car lar))) (setq p2 (last (cadr lar))))) 1) (if (< p1 p2) (setq s1 (list (cadr (car lar)) (caddr (car lar))) s2 (list (caddr (cadr lar)) (cadddr (cadr lar)))) (setq s1 (list (cadr (cadr lar)) (caddr (cadr lar))) s2 (list (caddr (car lar)) (cadddr (car lar)))) ) ) (if (and s1 s2) (if (setq pQbro (inters (car s1) (cadr s1) (car s2) (cadr s2) nil)) (while (setq p (nth (setq i (1+ i)) lst)) (setq lrr (if (= i (max p1 p2)) (cons pQbro (cons p lrr)) (cons p lrr))) ) ) ) (simplifPts lrr 0.001) ) (simplifPts lst 0.001) ) ) lst ) ) (defun ordenaPts (lst pIni / p dm d ps? ps pa lr xx =a) ; sort list points / ordena los puntos (while lst (foreach p lst (if (and dm (/= (min (setq d (distance (if ps ps pIni) p)) dm) dm)) (if (or (not lr) (not pa) (< (abs (asr pa ps p)) (/ PI 2.)) ) (setq dm d ps? p) ) (if (not dm) (if pa (if (< (abs (asr pa ps p)) (/ PI 2.)) (setq dm (distance ps p) ps? p) ) (setq dm (distance (if ps ps pIni) p) ps? p) ) ) ) ) (if (setq =a (equal ps? pa 1e-4)) (setq lst (vl-remove ps? lst) ps? nil dm nil) (setq pa ps ps ps? ps? nil dm nil lst (vl-remove ps lst) lr (cons ps lr)) ) ) lr ) ;;; This function projects normals and angle bisectors to the other edge ;;; Esta función proyecta normales y bisectrices hasta el otro margen (defun interCpta (pM p1 p2 lp / i? fueraSombra? i1 i2 d p b x lpe); pM: mid point / pm: es el punto medio a emplear como base. (defun fueraSombra? (p); 'pcu': last 'closestpoint' successful / 'pcu' ES EL ULTIMO 'closest' EXITOSO (if (minusp (* (asr p (car *lpB) (car *lpU)) *sombra*)); if returned sign chamged to 'asr', came out of the shadows (*sombra*) / es decir, si cambió el signo devuelto por 'asr' entonces salimos de la sombra (setq *sombra* nil p (list p (car *lpU))) ) ) (defun i? (pA pB lp / p0 i dm is a) (foreach p lp (if p0 (if (setq i (inters p0 (setq p0 p) pA pB)) (if (and dm (/= (min (setq d (distance pM i)) dm) dm)) (if (not (autoInt? (polar pM (setq a (angle pM i)) 1e-3) (polar i (+ a PI) 1e-3) lpe)) (setq dm d is i) ) (if (and (not dm) (not (autoInt? (polar pM (setq a (angle pM i)) 1e-3) (polar i (+ a PI) 1e-3) lpe))) (setq dm (distance pm i) is i) ) ) ) ) (setq p0 p) ) (if is (list (car is) (cadr is) 0.0) ) ) (setq lpe (if (equal e e1) lp1 lp2)) (if (and pM p1 p2 (or (setq p (i? p1 p2 lp)) (not (autoInt? (setq pu (vlax-curve-getClosestPointTo ee pM)) (polar pM (angle pM pu) 1e-3) lpe)))) (list pM (if p p (setq *mU m *pB pM *sombra* nil *pU pu))); *pU: last closest point on another edge / RECUERDA QUE *pU ES EL PUNTO CLOSETEADO ULTIMO EN EL OTRO MARGEN (if *sombra* (fueraSombra? pM) (if *pU; *pU SOLO SE CARGÓ CUANDO EL RESTO DE OPCIONES (normales y bisectriz) NO FUNCIONARON (if (autoInt? (setq x (if *lpU (car *lpU) *pU)) (polar pM (angle pM x) 1e-3) lpe);|If it also self-intecsects when searching for the last sucessfully closest point|; ;|SI TAMBIÉN SE AUTOINTERSECA AL BUSCAR EL ÚLTIMO PUNTO 'CLOSETEADO' EXITOSAMENTE|; (setq *sombra* (if (= (abs (- m *mU)) 1) (asr pM *pB *pU)) *lpU (cons *pU *lpU) *lpB (cons *pB *lpB) p nil) (if *lpU (list pM (car *lpU))) ) (alert "EXCEPTION!") ) ) ) ) (defun ptEqd (A B e1 e2 / eqDistf t0 t1 f0 f1 tm fm n i v+- v*); get eqdist point / captura punto equidistante (defun v+- (o a b) (mapcar o a b)) (defun v* (p s) (mapcar '(lambda (x) (* x s)) p)) (defun eqDistf (ds A B e1 e2 / pt d1 d2 p1) (setq pt (v+- '+ A (v* (v+- '- B A) ds)) d1 (distance pt (setq p1 (vlax-curve-getClosestPointTo e1 pt))) d2 (distance pt (vlax-curve-getClosestPointTo e2 pt)) *pr1 (vlax-curve-getParamAtPoint e1 p1) ) (- d1 d2) ) (setq t0 0.0 t1 1.0) (while (and (< (setq n (if n (1+ n) 0)) 100) (> (- t1 t0) 1e-6));bisection method/método de bisección (setq tm (/ (+ t0 t1) 2.0) fm (eqDistf tm A B e1 e2) ) (if (< (abs fm) 1e-9) (setq n 100 t1 tm t0 tm) (if (< (* (if f0 f0 (eqDistf t0 A B e1 e2)) fm) 0.0) (setq t1 tm f1 fm) (setq t0 tm f0 fm) ) ) ) (if (< t1 1.0) ; final parameter and eqdist point / parámetro final y punto equidistante (v+- '+ A (v* (v+- '- B A) (/ (+ t0 t1) 2.0))) ) ) (defun simplifPts (lst tol / po p0 p1 p> p a lr le np x);simplify list point / simplifica la lista de puntos (foreach p lst (if p0 (if p1 (if (setq po (inters p0 (polar p0 (setq a (angle p0 p1)) 1) p (polar p (+ a (/ pi 2)) 1) nil)) (if (> (distance po p) tol) (setq le (cons p1 le) p0 p1 p1 p x (if x (1+ x) 2) ) ; including point / si hay que incluir el punto (setq p1 p);deleting point/si hay que suprimirlo ) ) (setq p1 p) ) (setq p0 p le (cons p le)) ) (if (equal p (last lst) 1e-4) (setq le (cons p le))) ) le ) (defun flanquea (p0 p tol / pM px pEqd a d); It obtain points for the agreement between segments according tolerance / Obtiene los puntos para acuerdo de segmentos respetando tolerancia (setq pM (list (/ (+ (car p0) (car p)) 2.) (/ (+ (cadr p0) (cadr p)) 2.)) pEqd (ptEqd (setq pA (polar pM (setq a (+ (angle p0 p) (/ PI 2.))) 50)) (setq pB (polar pM (+ a PI) 50)) e1 e2) ) (if (> (distance pEqd pM) tol) (progn (setq lf (cons pEqd lf));saving / guardamos (if (not (member *pr1 lpr1)) (setq lpr1 (cons *pr1 lpr1))) (flanquea p0 pEqd tol) (flanquea p pEqd tol) ) ) (append lf (list p0 p)) ) (vl-catch-all-apply '(lambda() (if (and (setq e1 (car (entsel "\nSelect FIRST LWPolyline..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") ) (if (and (setq e2 (car (entsel "\nSelect SECOND LWPolyline..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") ) (progn (foreach l l1 (if (= (car l) 10) (setq lp1 (cons (cdr l) lp1)))) (foreach l l2 (if (= (car l) 10) (setq lp2 (cons (cdr l) lp2)))) (if (setq c?1 (= (rem (cdr (assoc 70 l1)) 2) 1)) (setq lp1 (cons (last lp1) lp1)) (setq c?1 (equal (car lp1) (last lp1) 1e-4)) ) (if (setq c?2 (= (rem (cdr (assoc 70 l2)) 2) 1)) (setq lp2 (cons (last lp2) lp2)) (setq c?2 (equal (car lp2) (last lp2) 1e-4)) ) (if (not c?1) (setq r1? (> (distance (car lp1) (car lp2)) (distance (car lp1) (last lp2))))) (setq tol (getreal "\nMaximum tolerance for equidistance within segments <0.005> : ") ; tolerance adjust / AJUSTAR TOLERANCIA AQUI tol (if tol tol 0.005) PI/2 (/ PI 2.) lp1 (if r1? (reverse lp1) lp1) t/2 (/ tol 2.) *lpB nil *lpU nil ) (foreach e (list e1 e2) (setq p0 nil m nil r? (if (setq =e1 (equal e e1)) r1?) lp (if =e1 lp2 lp1) c? (if =e1 c?1 c?2) ee (if =e1 e2 e1)) (while (setq p (vlax-curve-getPointAtParam e (setq m (if m ((if r? 1- 1+) m) (if r? (vlax-curve-getEndParam e) 0))))) (setq pu nil n1 nil n2 nil n3 nil) (if p0 (progn (setq lAB (interCpta p (polar p (setq a (+ (angle p0 p) PI/2)) 1e6) (polar p (+ a PI) 1e6) lp); normal at the begining of the segment / NORMAL AL COMIENZO DEL SEGMENTO lst (if lAB (cons (setq n1 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) (if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m))); (setq lAB (interCpta p (polar p (setq a (/ (+ (angle p p0) (angle p p>)) 2.)) 1e6) (polar p (+ a PI) 1e6) lp); bisector / Bisectriz lst (if lAB (cons (setq n2 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) lAB (interCpta p (polar p (setq a (+ (angle p p>) PI/2)) 1e6) (polar p (+ a PI) 1e6) lp); normal at the ending of the segment / NORMAL AL FINAL DEL SEGMENTO lst (if lAB (cons (setq n3 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) ) (setq p< p0 p0 p) ) (if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m))) (progn (setq lAB (interCpta p (polar (setq p0 p) (setq a (+ (angle p0 p>) PI/2)) 1e6) (polar p0 (+ a PI) 1e6) lp);normal at the begining of the segment / NORMAL AL COMIENZO DEL SEGMENTO lst (if lAB (cons (setq n1 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) (if c? (setq lAB (interCpta p (polar p (setq a (/ (+ (angle p (vlax-curve-getPointAtParam e (1- (vlax-curve-getEndParam e)))) (angle p p>)) 2.)) 1e6) (polar p (+ a PI) 1e6) lp ) lst (if lAB (cons (setq n2 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) ) ) ) ) ) ) (setq lst (cdr (simplifPts (reverse (ordenaPts lst (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (car lp2)))) 0.001)) p0 nil n -1) (if (and c?1 c?2) (setq lst (cons (last lst) lst))) (while (setq p (nth (setq n (1+ n)) lst)) (if p0 (if (or (and pa (setq pp (nth (1+ n) lst)) (setq p>< (inters pa p0 p pp nil)); intecsections of extensions / intersección de las prolongaciones (setq px (inters p0 p p>< (polar p>< (+ (angle p0 p) (/ pi 2)) 1) nil)); distance to the base segment / distancia al segmento base (> (distance p>< px) tol); separation greather than tolerance / si la separacion es superior a la tolerancia ) (and c?1 c?2) ) (setq pM (list (/ (+ (car p0) (car p)) 2.) (/ (+ (cadr p0) (cadr p)) 2.)) NoEq (> (setq df (/ (abs (- (distance pM (vlax-curve-getClosestPointTo e1 pM)) (distance pM (vlax-curve-getClosestPointTo e2 pM)))) 2.)) t/2) pp+ (if NoEq (if (< df tol) (if (setq p· (ptEqd (polar pM (setq a (+ (angle p0 p) PI/2)) 5) (polar pM (+ a PI) 5) e1 e2)) (progn (if (not (member *pr1 lpr1)) (setq lpr1 (cons *pr1 lpr1))) (list p0 p· p) ) ) (afina (ordenaPts (flanquea p0 p t/2) p0)) ) ) lf nil ) (setq pp+ nil) ) ) (setq lt (if p0 (cons p0 lt) lt) pa p0 p0 p ap a) (if pp+ (foreach v (reverse (cdr (reverse (cdr pp+)))) (setq lt (cons v lt)))) ) (setq lt (ordenaPts (simplifPts lt 0.001) p0)) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbPolyline") (cons 90 (length lt)) ) (foreach p lt (setq lps (cons (list 10 (car p) (cadr p)) lps)))) ) (if (or c?1 c?2) (entmod (append (entget (entlast)) '((70 . 1))))) ) ) ) ) ) (princ) ) It is an improvement over the last code I posted. However, I have abandoned this variant because, as you rightly pointed out in your previous post, it doesn’t work in some of your drawings, and fixing it turns out to be more complicated than is reasonably justified. Also, as I mentioned before, this approach is more brute-force and slower. Still, it is useful to illustrate what can be done in drawings like this. For that reason, I decided to publish it now. In my opinion, the best equidistant centerline should achieve everything that is possible and bound what is impossible within a tolerance. What is possible: Vertices: – all points or vertices of the centerline can and therefore must be equidistant. Segments: – all centerline segments that result from the overlap of segments on both margins (80/90%) must also be equidistant along their entire length. What is impossible: Segments: – the interior of segments that do not meet the previous condition cannot be geometrically equidistant, BUT their maximum “non-equidistance” should be bounded by a tolerance. Based on these criteria, for polylines representing linear entities such as rivers, roads, etc., this code should for tolerances down to 1 millimeter (the smaller the tolerance, the larger the resulting time&geometry).