Leaderboard

I copied another function of dijkstra's algorithm to find the shortest path. It might need a lot of optimization, but just as a proof of concept. centerline voronoi dijkstra.lsp Code I forgot to include: (defun RemoveDuplicatesAux ( x ) (cond ((vl-position x index)) ((null (setq index (cons x index)))) ) ) (defun RemoveDuplicates ( lst / index ) (vl-remove-if 'RemoveDuplicatesAux lst ) )

Using a voronoi diagram (code by ymg, ElpanovEvgeniy and Marko Ribar) You can get some very good reference points. Just have to find a way to get rid of all the 'branches' and then take al the midpoints of every line to get a good centerline. centerline-voronoi.lsp

I always try to avoid using command when I can. entmakex is faster and doesn't output to the command line. wrapping with setq you can even save the entity or add to selection set. (setq pts (list p1 p2 p3 p4)) (setq trap (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) ) (sssetfirst nil (ssadd trap))

From what I inspected... That @dexus code works well with correct implementation of djikstra... When I used his code it bumped into endless (while) loop... Here is my revision and it should work, but result is not exact... Seems that resulting polyline is rummaging between references... Here is my revision : ; Attempt at drawing a centerline using voronoi diagram ; Voronoi diagram calculations found here: https://www.theswamp.org/index.php?topic=45085.msg503034#msg503034 (defun c:cl (/ _side ent->pts removeDuplicates minlen RemoveIDDup minpath1 triangulate getcircumcircle ss ent1 ent2 pl s1 s2 vor line) (defun _side (pline pnt / cpt end target der) (setq cpt (vlax-curve-getClosestPointTo pline pnt) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 end (vlax-curve-getEndParam pline) target (vlax-curve-getParamAtPoint pline cpt) der (if (and (equal target (fix target) 1e-8) (or (vlax-curve-isClosed pline) (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8))) ) ) (mapcar (function -) (polar cpt (angle (list 0.0 0.0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0) (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) (list 0.0 0.0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle (list 0.0 0.0) der)))) ) (defun _polyline (pts) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar (quote clayer))) (cons 70 0) ) (mapcar (function (lambda (x) (cons 10 x))) pts) ) ) ) (defun ent->pts (ent acc / end ind step rtn) (setq end (vlax-curve-getEndParam ent)) (setq ind (vlax-curve-getStartParam ent)) (setq step (/ end (float acc))) (while (< ind end) (setq rtn (cons (vlax-curve-getPointAtParam ent ind) rtn)) (setq ind (+ ind step)) ) rtn ) (defun removeDuplicates (lst / a ll) (while (setq a (car lst)) (if (vl-some (function (lambda (x) (equal x a 1e-6))) (cdr lst)) (setq ll (cons a ll) lst (vl-remove-if (function (lambda (x) (equal x a 1e-6))) (cdr lst))) (setq ll (cons a ll) lst (cdr lst)) ) ) (reverse ll) ) ; https://www.theswamp.org/index.php?topic=45092.msg578984#msg578984 (defun minlen (LtsLine startEnd / ID1 ID2 IDEnd IDStart LtsID LtsIDFil LtsIDPnt LtsID_Edge LtsPath P1 P2 listpoint) (setq LtsPnt (removeDuplicates (apply (function append) LtsLine))) (setq LtsIDPnt (mapcar (function (lambda (x) (list (vl-position x LtsPnt) x))) LtsPnt)) (setq LtsID (mapcar (function (lambda (x) (vl-position x LtsPnt))) LtsPnt)) (setq IDStart (vl-position (caar startEnd) LtsPnt)) (setq IDEnd (vl-position (caadr startEnd) LtsPnt)) (setq LtsID_Edge (list)) (foreach e LtsLine (setq ID1 (caar (vl-remove-if-not (function (lambda (x) (equal (car e) (cadr x) 1e-6))) LtsIDPnt))) (setq ID2 (caar (vl-remove-if-not (function (lambda (x) (equal (cadr e) (cadr x) 1e-6))) LtsIDPnt))) (setq LtsID_Edge (append LtsID_Edge (list (list ID1 ID2 (distance (nth ID1 LtsPnt) (nth ID2 LtsPnt)))))) ) (setq LtsIDFil (RemoveIDDup LtsID_Edge)) (setq LtsPath (minpath1 IDStart IDEnd LtsID LtsIDFil)) (setq listpoint (mapcar (function (lambda (x) (nth (car x) LtsPnt))) LtsPath)) ) (defun RemoveIDDup (l) (if l (cons (car l) (RemoveIDDup (vl-remove-if (function (lambda (x) (or (and (= (car x) (car (car l))) (= (cadr x) (cadr (car l))) ) (and (= (car x) (cadr (car l))) (= (cadr x) (car (car l))) ) ) )) (cdr l) ) ) ) ) ) (defun minpath1 (g f nodes edges / brname clnodes closedl go new nodname old openl totdist ppath) (setq nodes (vl-remove g nodes)) (setq openl (list (list g 0 nil))) (setq closedl nil) (setq go t) (foreach n nodes (setq nodes (subst (list n 0 nil) n nodes)) ) (while (and go (not (= (caar closedl) f))) (setq nodname (caar openl)) (setq totdist (cadar openl)) (setq closedl (cons (car openl) closedl)) (setq openl (cdr openl)) (setq clnodes (mapcar (function car) closedl)) (foreach e edges (setq brname nil) (cond ( (= (car e) nodname) (setq brname (cadr e)) ) ( (= (cadr e) nodname) (setq brname (car e)) ) ) (if brname (progn (setq new (list brname (+ (caddr e) totdist) nodname)) (cond ( (member brname clnodes) ) ( (setq old (vl-some (function (lambda (x) (if (= brname (car x)) x))) openl)) (if (< (cadr new) (cadr old)) (setq openl (subst new old openl)) ) ) ( t (setq openl (cons new openl)) ) ) ) ) ) (setq openl (vl-sort openl (function (lambda (a b) (< (cadr a) (cadr b)))))) (and (null openl) (null (caar closedl)) (setq go nil)) ) (setq ppath (list (car closedl))) (foreach n closedl (if (= (car n) (caddr (car ppath))) (setq ppath (cons n ppath)) ) ) ppath ) ;;***************************************************************************; ;; Triangulate ; ;; Structure of Program by ElpanovEvgeniy ; ;; 17.10.2008 ; ;; edit 20.05.2011 ; ;; Program triangulate an irregular set of 3d points. ; ;; Modified and Commented by ymg June 2011. ; ;; Modified to operate on index by ymg in June 2013. ; ;; Contour Generation added by ymg in July 2013. ; ;; Removed lots of code not used for centerline function November 2025. ; ;;***************************************************************************; (defun triangulate (pl / a al b bb c cp ctr e el epos l n np npos pt r sl tl tr vl vor xmax xmin ymax ymin) (if pl (progn (setq tl nil pl (vl-sort pl (function (lambda (a b) (< (car a) (car b))))) ; Sort points list on x coordinates bb (list (apply 'mapcar (cons 'min pl)) (apply 'mapcar (cons 'max pl))) ; Replaced code to get the min and max with 3d Bounding Box Routine ; A bit slower but clearer. zmin and zmax kept for contouring xmin (caar bb) xmax (caadr bb) ymin (cadar bb) ymax (cadadr bb) np (length pl) ; Number of points to insert cp (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0)) ; Midpoint of points cloud and center point of circumcircle through supertriangle. r (* (distance cp (list xmin ymin)) 20) ; This could still be too small in certain case. No harm if we make it bigger. sl (list (list (+ (car cp) r) (cadr cp) 0) (list (- (car cp) r) (+ (cadr cp) r) 0) (list (- (car cp) r) (- (cadr cp) r) 0) ) ; sl list of 3 points defining the Supertriangle, I have tried initializing to an infinite triangle but it slows down calculation pl (append pl sl) ; Vertex of Supertriangle are appended to the Point list sl (list np (+ np 1) (+ np 2)) ; sl now is a list of index into point list defining the supertriangle al (list (list xmax cp r sl)) ; Initialize the Active Triangle list ; al is a list that contains active triangles defined by 4 items: ; item 0: Xmax of points in triangle. ; item 1: List 2d coordinates of center of circle circumscribing triangle. ; item 2: Radius of above circle. ; item 3: List of 3 indexes to vertices defining the triangle ctr (list cp) ; added for Voronoi n -1 ; n is a counting index into Point List ) ; Begin insertion of points (repeat np (setq n (1+ n) ; Increment Index into Point List pt (nth n pl) ; Get one point from point list el nil) ; el list of triangles edges (repeat (length al) ; Loop to go through Active triangle list (setq tr (car al) ; Get one triangle from active triangle list. al (cdr al)) ; Remove the triangle from the active list. (cond ( (< (car tr) (car pt)) (setq tl (cons (cadddr tr) tl) ctr (cons (cadr tr) ctr)) ; added for voronoi ) ; This triangle inactive. We store it's 3 vertex in tl (Final triangle list). ( (< (distance pt (cadr tr)) (caddr tr)) ; pt is inside the triangle. (setq tr (cadddr tr) ; Trim tr to vertex of triangle only. a (car tr) ; Index of First point. b (cadr tr) ; Index of Second point. c (caddr tr)) ; Index of Third point. (setq el (vl-list* (list a b) (list b c) (list c a) el)) ; ((a b) (b c) (c a) (. .) (. .).....) ) ( t (setq l (cons tr l)) ) ; tr did not meet any cond so it remain active. We store it in the swap list ) ; End cond ) ; End repeat (length al) (setq al l ; Restore active triangle list from the temporary list. l nil) ; Clear the swap list to prepare for next insertion. ; Removes doubled edges, calculates circumcircles and add them to al (while el (if (or (member (reverse (car el)) el) (member (car el) (cdr el)) ) (setq el (vl-remove (reverse (car el)) el) el (vl-remove (car el) el)) (setq al (cons (getcircumcircle n (car el) pl) al) el (cdr el)) ) ) ) ; End repeat np ; We are done with points insertion. Any triangle left in al is added to tl (foreach tr al (setq tl (cons (cadddr tr) tl) ctr (cons (cadr tr) ctr)) ; Added for Voronoi ) ; Extract all triangle edges from tl and form edges list el (setq el nil) (foreach tr tl (setq el (vl-list* (list (caddr tr) (car tr)) (list (cadr tr) (caddr tr)) (list (car tr) (cadr tr)) el ) ) ) (setq el (reverse el)) ; Here let's draw the Voronoi Diagram (setq vl nil) (foreach e el (setq npos (vl-position (reverse e) el) epos (vl-position e el)) (if npos (setq vl (cons (list (/ npos 3) (/ epos 3)) vl)) (setq vl (cons (list (- (length ctr) 1) (/ epos 3)) vl)) ) ) (setq vor nil) (while vl (setq e (car vl) vl (vl-remove (reverse e) (cdr vl)) vor (cons e vor)) ) (mapcar (function (lambda (v) (list (nth (cadr v) ctr) (nth (car v) ctr) ) )) (cdddr ; Remove the edges of Supercircle (vl-sort vor (function (lambda (a b) (> (car a) (car b)) )) ) ) ) ) ) ) ;;************************************************************************************************; ;; Written by ElpanovEvgeniy ; ;; 17.10.2008 ; ;; Calculation of the centre of a circle and circle radius ; ;; for program triangulate ; ;; ; ;; Modified ymg june 2011 (renamed variables) ; ;; Modified ymg June 2013 to operate on Index ; ;;************************************************************************************************; (defun getcircumcircle (a el pl / b c c2 cp r ang vl pt) (setq pt (nth a pl) b (nth(car el) pl) c (nth(cadr el) pl) c2 (list (car c) (cadr c)) ; c2 is point c but in 2d vl (list a (car el) (cadr el))) (if (not (zerop (setq ang (- (angle b c) (angle b pt))))) (progn (setq cp (polar c2 (+ -1.570796326794896 (angle c pt) ang) (setq r (/ (distance pt c2) (sin ang) 2.0))) r (abs r)) (list (+ (car cp) r) cp r vl) ) ) ) (if (not (while (cond ( (not (setq ss (ssget (list (cons 0 "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") ) ( (/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ( (and (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq pl (append (ent->pts ent1 100) (ent->pts ent2 100))) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) (progn (setq s1 (_side ent1 (vlax-curve-getStartPoint ent2))) (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1))) (setq vor (triangulate pl)) (setq vor (vl-remove-if-not (function (lambda (line) (and (equal s1 (_side ent1 (car line))) (equal s1 (_side ent1 (cadr line))) (equal s2 (_side ent2 (car line))) (equal s2 (_side ent2 (cadr line))) ) )) (vl-remove-if (function (lambda (x) (or (equal x (list nil nil)) (not (car x)) (not (cadr x))))) vor) ) ) (if (< (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2)) (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) ) (setq start (list (vlax-curve-getEndPoint ent1) (vlax-curve-getStartPoint ent1)) end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2))) (setq start (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1)) end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2))) ) (setq startEnd (mapcar (function (lambda (end1 end2) (caar (vl-sort (mapcar (function (lambda (line) (list line (+ (distance (car line) end1) (distance (car line) end2) (distance (cadr line) end1) (distance (cadr line) end2) ) ) )) vor ) (function (lambda (a b) (< (cadr a) (cadr b)) )) ) ) )) start end ) ) (_polyline ( (lambda (lst / rtn) ; Draw a line of the midpoints of voronoi lines (while (cdr lst) (setq rtn (cons (mapcar (function (lambda (a b) (* (+ a b) 0.5))) (car lst) (cadr lst) ) rtn ) ) (setq lst (cdr lst)) ) rtn ) (minlen vor startEnd) ) ) ) ) (princ) )

Another for fun - should work in all UCS/Views: (defun c:itsatrap ( / hgt len ocs off pt1 pt2 ) (if (and (setq pt1 (getpoint "\nInsertion point: ")) (setq len (getdist "\nLength of base: " pt1)) (setq hgt (getdist "\nHeight: " pt1)) (setq ocs (trans '(0 0 1) 1 0 t) pt2 (cons (+ (car pt1) len) (cdr pt1)) off (* hgt (/ (sqrt 3) 3)) ) ) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 (trans pt1 1 ocs)) (cons 10 (trans pt2 1 ocs)) (cons 10 (trans (list (+ (car pt2) off) (+ (cadr pt2) hgt) (caddr pt2)) 1 ocs)) (cons 10 (trans (list (- (car pt1) off) (+ (cadr pt1) hgt) (caddr pt1)) 1 ocs)) (cons 210 ocs) ) ) ) (princ) )

@Nikon IMHO - the extra variables that mhupp referenced in his example are unnecessary, and you didn't localize them. I'd recommend you simplify to this: (defun c:trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (x) (cons 10 x)) (list p1 p2 p3 p4)) ) ) ) ) )

@mhupp that works fine. I personally think the benefits are extremely tiny on such a simple code form. For short routines, I tend to just use the command sequence. On more intensive stuff I use the ActiveX entity creation more often then using entmake with DXF codes.

Here's my quick version: (defun c:trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") ) ) )

I think you should rename the variable 'angle': 'angle' is a language symbol, that is, a function. Try changing it to 'ang', for example.

You can limit what ssget selects by entity, layer, color, size, basically anything in dxf codes. please read up on ssget This means you could just make a window selection. And not have to zoom in and out to make selections. also @Steven P already said "ssadd does a check if the entity exists in the set" check the length of SS before and after to see if it was already in the list. also also looks like your not using localized variables could be why its taking so long. (defun C:123 ( / ss pick l) (setq ss (ssadd)) (princ "\nSelect Entity: ") (while (setq pick (ssget)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex pick))) (setq l (sslength ss)) ; Length before adding (setq ss (ssadd ent ss)) ; Try adding entity (if (= l (sslength ss)) ; If length is the same, item was already in list (princ "\n\nDuplicate Selected Line") ) ) (princ (strcat "\n" (itoa (sslength ss)) " Entities now in Selection SS")) ) ; rest of code goes here (princ) ) (defun C:bm ( / ss ent) (while (setq SS (ssget (ssget "_+.:E:S"))) ;exits if selection isn't made (setq ent (ssname ss 0)) ;CODE ) )

Everything SLW210 has researched is very interesting. I had no idea this had been such a thoroughly discussed topic — and with such limited success. I guess that makes it even more interesting. In my opinion, it is possible to obtain a center polyline that is equidistant from both edges. But two conditions must be met: 1. The user must ensure that the geometry of both edges is correct: they must be 2D polylines with no repeated points and no geometric inconsistencies of any kind. And, in principle, to avoid extending the search for a solution, these polylines should not contain arcs. 2. One must accept that any edge containing “recesses” (“recodos”) must be handled using auxiliary axes. What is a recess? It is a geometric setback, in any direction, along one of the edges. For example: if you advance segment by segment along an edge (in either direction), the start of a recess would be defined as any vertex from which the shortest distance to the opposite edge forces the projection to intersect its own edge. My conclusion: for edges without recesses, I believe it is possible to find an equidistant centerline or axis. And for edges with recesses, although considerably more code will be needed, they should be solvable using auxiliary axes. I hope to have code soon that supports all of this.

Case 1: ssadd does a check if the entity exists in the set, you can change CASE 1 (setq ss (ssadd)) (if (not (ssmemb n ss)) (ssadd n ss) ;code );if to CASE 1 (ssadd n ss) ;code Often in code optimisation is rarely a single line that makes a difference... unless you are doing thousands of calculations, so here taking out an if statement won't do a lot. Most likely you have a loop within a loop that slows things - might be more efficient to look back at how you are selecting the entities and processing them before adding to the selection set. However don't just accept that, if you code will work without the line take out your if statement, and ssadd and you shouldn't really notice a big difference in speed

I now have tried a few methods, they all miss the center somewhere on the complicated "turns". As I mentioned, even the GIS/Civil programs get similar results at times. I did rabbit hole Bowyer–Watson algorithm and the Delaunay triangulation to obtain a Voronoi diagram of the points. That might be over my head for LISP, I think I have seen references for Python and C# though. I had decent results with my export to CSV and import a center line back, though still has an off center place or two on the OPs example.

If you want 30 degree use (* (/ 1.0 6.0) pi) My $0.05 the front end can preset values but change as required. (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter Values" "Base Width " 5 4 "100" "Height " 5 4 "100" "Angle" 5 4 "30" ))) (setq Wid (atof (nth 0 ans)) ht (atof (nth 1 ans)) ang (atof (nth 2 ans))) (setq ang (* pi (/ ang 180.0))) Multi GETVALS.lsp

@mhupp No problem my friend. I agree wholeheartedly that it's good to show alternative ways to do the code - helps folks to learn the way it works. Cheers

I was just showing a different way to do things. In AutoCAD do whatever your comfortable with. Yes with simple code you will never see a difference in time.

I replaced in the code @pkenewell (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") with (entmakex… It works too. ;; pkenewell 14.11.2025 (defun c:trapezoid-pk-mh (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) ; (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") ; pkenewell (setq pts (list p1 p2 p3 p4)) ; mhupp (setq trap (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) ) ) ) (princ) )

Replace (command-s line with what i posted. the (sssetfirst line isn't need just to show as an example.

@pkenewell Thank you, your code works perfectly! And thank you for the possibility of choice the angle.

Untested, but it should work IMHO... (defun c:DrawTrapez30 (/ baseHeight height ang radian topBase pt1 pt2 pt3 pt4) (initget 7) (setq baseHeight (getreal "\nEnter the size of the bottom base: ")) (initget 7) (setq height (getreal "\nEnter the height of the trapezoid: ")) ;; Angle in radians (setq ang 30) (setq radian (* ang (/ pi 180.0))) ;; Determining the starting point (setq pt1 (mapcar (function +) (list 0.0 0.0) (getpoint "\nEnter the starting point of the lower base: "))) ;; Calculating the coordinates of the vertices of a trapezoid (setq pt2 (polar pt1 0.0 baseHeight)) (setq pt3 (polar pt2 (- (* 0.5 pi) radian) (/ height (cos radian)))) (setq pt4 (polar pt1 (+ (* 0.5 pi) radian) (/ height (cos radian)))) ;; Calculating the upper base (setq topBase (distance pt3 pt4)) ;; Drawing a trapezoid (command "_.pline" "_non" pt1 "_non" pt2 "_non" pt3 "_non" pt4 "_C") (princ) )

Reading about selection sets yesterday, if you are deleting from a selection set within your code, be aware that the entire set is indexed again which can add in delays (set contains entities 1 2 3 4 5 6 78 9, delete entity 5 from the set, then 6 7 8 and 9 are all indexed again to be 5 6 7 8 - time which can add up with very large selection sets). For case 1 I would be considering what you are doing in ';;;;code' to see if there are efficiencies in there (try running it as you write above to get a benchmark for the speed over your large selection set without any other codes)

I've tested the code. In this way, it is difficult to guess the desired position of the dim text. Then you have to manually correct the position of the dim text. I'm using a macro *^C^C_aidimtextmove;1;\; to move dim text with an indication of position. You can write this macro as code, but the command works once with one size, I can't add a loop to change multiple sizes in one command call. (vl-load-com) (defun C:dimtxtmove (/ ) (vl-cmdf "_aidimtextmove" "1") (vl-cmdf pause) (vl-cmdf "") (princ) )

Yeah didn't think this would be so difficult. posting what I have so far. but I think ill stop here as this code is just for testing and only leaves points and not a drawing a continuous polyline. mid.mp4 -edit would notice that line types would stop the code for some reason so hard coded continuous. or maybe just my ganky code. midpoints.lsp

I think ronjonp posted something that if you clicked two points on a polyline it would find the shortest path. (traveling salesman) The method I was working on but haven't finished. two open polylines find start and end points of each test how they are oriented and revers one to use to make a closed polyline find the longest distance between the two original polyline divide that by like 500 and offset in using entlast and eventually will end (cant offset anymore) find the polyline with the lowest area but still has the same amount of vertex as the original boundary. using that smaller boundary to draw vector lines between smallest and original boundary. (where im at now) take all other polylines inside smallest and add them to a point list. remove any points that are Collinear with any of the drawn vector lines. this should leave only the points on the center line. starting at one end need to start group points that are Collinear to each other. of those points entmake a line on the farthest distance. these lines are incomplete segments or might not be touching and will need to be extended to each other or the vector lines or both. problem i am finding/trying to solve what slw210 pointed out about if two segments are close to being parallel points wont be found. need three points to calculate collinear working over a group of points to split out each segment.

I have been trying to explain the issues to the OP to no avail. From what I gather from my daughter, her coworker does the centerlines in CAD not ArcGIS, then imports them. From what I gather, CAD is better for tweaking a more accurate line manually after running a LISP or other program. Which is apparently what some if not most of the surveyors, geologist, map/civil, etc. are doing no matter the GIS software or CAD software. Getting it close with a tool then tweaking it if needed, or probably if just a one time deal completely manually. I have a couple of new LISPs, I left one of them to draw a different centerline depending on which polyline is picked first, between the two centerlines, one goes close to perfect through the right curves, the other close to perfect through the left curves on the OPs AxisExample.dwg. As I posted, a Voronoi is what most of the tools use, apparently they can get off center as well, but generally work the best. The other option is to go LRM's method or along the lines of Jeffery P. Sanders rolling ball, but the rolling ball can take a while it seems to if looking for accuracy. Daniel's Python method would probably be the best IMO. I still plan on seeing QGIS results when I get the time.

Have a progress output to the bottom left for long process is always a good idea because people will cancel commands that they think are hung. https://www.cadtutor.net/forum/topic/75702-all-objects-inside-this-selection-want-to-send-layer-0/#findComment-598604 in the update loop if user hits esc exit lisp

Case 2: This nicest user friendly way I found.. is not the nicest user friendly way in programming - involves grread which the help suggests is rarely needed and for advanced users.... grread if the input is keyboard or mouse input. If keyboard check if it is enter, X, space or escape (enter, space, escape got to use character codes) else ignore text inputs. If mouse input check if they have selected an object or just clicking empty space However the help suggests doing this in other ways. For both cases, and MHUPPs question what is the goal you are wanting to achieve.

Apparently, it’s a difficult task, people write papers on them https://ieeexplore.ieee.org/stamp/stamp.jsp?arnumber=8625416

Can also put these into a routine: (command "-layer" "ON" "ListofLayers, EachLayerSeperated, Withcomma" "") ; Turns layer ON.. try 'OFF' (command "-layer" "FREEZE" "ListofLayers, EachLayerSeperated, Withcomma" "") ; Freezes layer, ty 'Thaw' as well For completion: (command "-layer" "SET" "LayerName" "") ; Sets current layer MHUPPs probably runs faster (like milliseconds) and a nice option to choose the layer, my ideas maybe better if the layer names are set and can be hard coded into the routine... but useless if each drawing / project uses a different name

They are either on a locked layer. have an error msg saying # number entitys on locked layer can't move. or inside a block or xref. (setq ss (ssget "WP" Co-ord)) ; Select all entities in window polygon (setq lock (ssget "WP:L" Co-ord)) ; Select entities not on locked layers (setq n (- (sslength ss) (sslength lock))) ; Calculate difference (if (> n 0) ; if n is greater than 0 display msg (prompt (strcat "\n" (itoa n) " entities on a locked layer")) )

Depends on what you want to do. this will freeze a layer of the entity you select is on. (defun c:FreezeEntity (/ ent layN layO) (while (setq ent (entsel "\nSelect an entity to freeze layer: ")) (setq layN (cdr (assoc 8 (entget (car ent))))) (setq layO (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object))) layN)) (vla-put-Freeze layO :vlax-true) (prompt (strcat "\nLayer \"" layN "\" has been frozen.")) ) (princ) ) -Edit Why not just have the calculations on defpoints or some other layer that is set not to print. (vla-put-Plottable layo :vlax-false)

I tried @aridzv first lisp and it's working fine on my end. Yellow ones are moved to layer "Site", the Red ones are moved to "exist" layer as what he mentioned. Though these are all just rectang and PL. haven't tried it with blocks.

"Plines in same direction", Yes Lee-Mac has a method also. Note the use of Pedit as Bricscad does not have a "Reverse" command, as at V25. ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (command "Pedit" ent "R" "") ) (princ) ) (defun c:CWCCW ( / *error* x ent oldsnap doc ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (prompt (strcat "\nSelect Plines to check")) (if (setq ss (ssget '((0 . "*POLYLINE")))) (progn (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (AH:chkcwccw ent) ) ) ) (vla-endundomark doc) (alert (strcat (rtos y 2 0) " Plines reversed")) (setvar 'osmode oldsnap) (princ) ) (vl-load-com) (prompt "\nType CWCCW to set plines to CCW") (c:CWCCW)

From what I have gathered, no easy task to do this, many GIS programs seem to struggle with pinpoint accuracy as well. The method for QGIS, is involved, so I didn't get time to run through it with the plugin, but I did dig into reddit and some GIS sites. Basically they do similar method, they just add a lot of points down the "polyline/line" and run the appropriate "centerline tool". Where someone posted results, I saw some in some of them the same "off center through some areas" as in the methods posted here. This was apparently plenty good enough for most GIS users, though I only did a relatively quick dig. In a similar method for AutoCAD, maybe adding more points to the polylines would help. I might have time Monday at home to check QGIS. Though I did import the OPs drawings into a session, the first one comes in very strange, the second seemed to be correct. The OP still hasn't answered why the second .dwg posted comes up as not an AutoCAD drawing. For AutoCAD, it helps if BOTH polylines go the same direction.

My $0.05 does not check for off or frozen layers. (defun c:wow ( / ent co-ord ss) (if (tblsearch "layer" "Site") (princ) (command "-layer" "Make" "Site" "c" 1 "" "") ) (if (tblsearch "layer" "Exist") (princ) (command "-layer" "Make" "Exist" "c" 2 "" "") ) (command "chprop" "all" "" "la" "Site" "") (setq ent (car (entsel "\nPick the pline "))) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq ss (ssget "WP" Co-ord)) (command "chprop" ss "" "LA" "Exist" "") (princ) ) (c:wow)

Another... https://forums.augi.com/showthread.php?170434-MText-width-set-to-zero&s=8d83700e43971c18c05d195f56cd176a&p=1330953&viewfull=1#post1330953

yes you can. Add a filter for wall using Type Name and apply that filter in View. hit VG and edit the filter CUT Properties according to your liking. Turn off Thin Lines to check the line thickness.

Autocad EXTRIM command, select polygon and click outside

Here's my non-VL method by pure maths: (defun c:chf ( / dis getline ins len ln1 ln2 p1 p11 p12 p2 p21 p22) (defun getline (msg / ln) (while (progn (setvar 'errno 0) (setq ln (car (entsel msg))) (cond ((= (getvar 'errno) 7) (princ "\nNothing selected")) ((null ln) nil) ((not (eq (cdr (assoc 0 (entget ln))) "LINE")) (princ "\nObject is not a line")) ) ) ) ln ) (setq ln1 (getline "\nSelect first line: ") ln2 (getline "\nSelect second line: ") dis (getdist "\nSpecify line length: ") p11 (cdr (assoc 10 (entget ln1))) p12 (cdr (assoc 11 (entget ln1))) p21 (cdr (assoc 10 (entget ln2))) p22 (cdr (assoc 11 (entget ln2))) ins (inters p11 p12 p21 p22 nil) ) (if ins (mapcar '(lambda (x y / len p1 p2) (if (and (not (equal x ins 1e-8)) (not (equal y ins 1e-8)) ) (progn (setq len (/ dis (sqrt (* 2 (- 1 (cos (JH:InnerAngle x ins y)))))) ; <-- cosine rule p1 (polar ins (angle ins x) len) p2 (polar ins (angle ins y) len) ) (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))) ) ) ) (list p11 p12 p11 p12) (list p21 p22 p22 p21) ) ) (princ) ) ;; JH:InnerAngle --> Jonathan Handojo ;; Returns the smaller angle between three point p1 p2 p3 ;; with p2 as the pivot, in radians. (defun JH:InnerAngle (p1 p2 p3 / 2p ang) (setq ang (- (angle p2 p3) (angle p2 p1)) 2p (+ pi pi)) (while (not (<= 0 ang 2p)) (if (< ang 0) (setq ang (+ ang 2p)) (setq ang (- ang 2p)))) (if (> ang pi) (- 2p ang) ang) )