All Activity

@Tamim Try this code and see if it helpful: (prompt "\nTo run a LISP type: LPL") (princ) (defun c:LPL ( / ss len circ txt_height lst i minPt maxPt midPt circle inc ang num ptlist k pt ssn pl_len ins_pt) (prompt "\nSelect all TEXT entities:\n") (setq ss (ssget (list (cons 0 "TEXT"))) len (sslength ss) circ 0.05 ;; radius of the circle can be changeable txt_height 0.01 ;; mtext height can be changeable lst (list) i 0 ) (while (< i len) (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt) (setq minPt (vlax-safearray->list minPt) maxPt (vlax-safearray->list maxPt) midPt (mapcar '* (mapcar '+ minPt maxPt) (list 0.5 0.5)) ) (entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle") (cons 8 (getvar 'clayer)) (cons 10 midpt) (cons 40 circ))) (setq circle (entlast) inc 0.25 ang 0 num (fix (/ (* pi 2) inc)) ptlist (list) k 0 ) (repeat num (setq pt (polar midPt ang circ) ptlist (append (list pt) ptlist) ang (+ ang inc) ) ) (setq ssn (ssget "_F" ptlist (list (cons 0 "LWPOLYLINE"))) pl_len (getpropertyvalue (ssname ssn k) "Length") ) (entdel circle) (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) "\t " (rtos pl_len 2 3) "\\P") lst) i (1+ i) ) ) (setq lst (vl-sort lst (function (lambda (x e) (< (atoi (substr (car x) 3 (strlen (car x)))) (atoi (substr (car e) 3 (strlen (car e)))))))) lst (cons (list "\\fArial|b0|i0|c0|p34;S.No\tLength Ft\\P") lst) ins_pt (getpoint "\nPick the insertation point:") ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 8 (getvar 'clayer)) (cons 10 ins_pt) (cons 40 txt_height) (cons 72 1) (cons 1 (apply 'strcat (mapcar '(lambda (x) (apply 'strcat x)) lst))))) (prompt "\nThe labels and the length of the polylines were added as MTEXT!") (princ) ) Also, you can see the short video example of how it works. LengthPolylineMtext.mp4 Best regards.

Thanks @Danielm103 That seems pretty accurate, although geometrically massive. It seems like there are a lot of points that aren't necessary. I guess something elegant should be only what's geometrically necessary. But I wonder what the result looks like when the geometry of the reference polylines is more extensive and varied.

Shapley or geopandas can create this, there’s artifacts though. The algorithm is some sort of Voronoi https://centerline.readthedocs.io/en/latest/# https://gis.stackexchange.com/questions/474810/how-to-get-the-centerline-of-a-polygon-without-artefacts-in-python a bit wonky

No, the program is required to define the reactors used to update the textbox position.

I used a similar approach here, the user wanted to set the elevation of the contour lines to the nearest label. This is where KD-Trees really start to shine as they can handle millions of points, with millions of searches

Yeah, I chose to search for the closest polyline to the text. BricsCAD has ssget crossing circle , (ssget "CC" point1 point2), could be similar to a radius search. Caveat, you’d have to call ssget for every mtext There’s a .DWG in the original post in the lisp forums

Just a comment done a lot of find object next to text, just used get text insertion point, then use "ssget "F" pts" the pts are say 10 points made via a polar defun looking like a circle . I noticed you go the other way around looking around the pline for the text. Would be good to get a true sample dwg.

Yep, easier too, since there would be not need to format the string for MText. Even though Python has robust string operations, it’s still weird to get it perfect https://docs.python.org/3/library/string.html I was just following along the original sample. The part I wanted to illustrate was, using a hashmap for mapping points to objects, and using the KD-Tree to do the spatial search I wrote the same KD-Tree and map for AutoLISP, I’m just really bad at lisp, so it’s hard for me to make samples lol https://github.com/CEXT-Dan/ads_geo

Would a table answer be perhaps neater than Mtext ? Just ask for text size for table.

I've disabled some lines of your code that weren't working and added some new lines of code. I hope this helps.

Your code, ready. (defun C:bm (/ obj num i obj1 db ct rd ang1 ang2 p1 p2 r ptlist) (setvar "osmode" 0) ; Turn off OSNAP (setq obj (ssget '((0 . "LWPOLYLINE,ARC")))) (setq num (sslength obj)) (setq i 0) (repeat num (setq obj1 (ssname obj i)) (setq db (entget obj1) ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) db)) i 0 ) (if (= (cdr (assoc 0 db)) "ARC") (progn (setq ct (cdr (assoc 10 db))) (setq rd (cdr (assoc 40 db))) (setq ang1 (* (cdr (assoc 50 db)) (/ 180.0 pi)) ang2 (* (cdr (assoc 51 db)) (/ 180.0 pi)) ) (setq p1 (polar ct ang1 rd)) (setq p2 (polar ct ang2 rd)) (command "_.dimradius" "_non" p1 "_non" p2 "") (command "_.dimarc" "_non" p1 "_non" p2 "") ) ;progn ;;; (progn ;polyline arc segment ;;;;;code (foreach l db (if (= (car l) 10) (if p1 (if bulge (progn (command "_.dimradius" "_non" p1 "_non" (cdr l) "") (command "_.dimarc" "_non" p1 "_non" (setq p1 (cdr l)) "") ; ) ) (setq p1 (cdr l)) ) (if (= (car l) 42) (setq bulge (/= (cdr l) 0.0))) ) ;;; (if (/= bulge 0.0) ;;; (progn ;;; (setq p1 (nth i ptlist)) ;;; (setq p2 (nth (+ i 1) ptlist)) ;;; ;;; (command "_.dimradius" "_non" p1 "_non" p2 "") ;;; (command "_.dimarc" "_non" p1 "_non" p2 "") ; ;;; ) ;progn ;;; ) ;if ) ;progn ) (setq i (1+ i)) ) ;repeat end ; Turn off OSNAP (setvar "osmode" 511) (princ) )

Dear sir one question after i save the drg and again open the drg without this lisp load text or mtext not working... its possible one time used the code and this Associative text are working without upload the code everytime..

thanks sir, its perfect

It will require more modification than just extending the bulge list - you also need to calculate the positions of the additional vertices. However, I really liked your suggestion (and it's also consistent with my existing Box Text program), and so I've updated the program to Version 1.3 to incorporate a new Filleted Rectangle textbox option (you may need to refresh the page to view the new version). Enjoy!

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/performance-issue-with-read-line-on-large-csv-files/td-p/13865858

Dear Sir, i trying add one more option Slot-1 rectangle with all corner rounded but result not as per image assoctextbox ((= "SLOT-1" typ) '(0.0 0.3 0.0 0.3 0.0 0.3 0.0 0.3)) and also try ((= "SLOT-1" typ) '(0.0 0.3 0.0 0.3 0.0 0.3 0.0 0.3 0.0 0.3 0.0 0.3 0.0 0.3 0.0 0.3)) but result shown wrong i want same result as per attached image AssociativeTextboxV1-2.lsp

A start with this ? (vl-load-com) (defun make_mlead (pt o r obj / ptlst arr nw_obj) (setq ptlst (append pt (polar pt o r)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "{\\fArial|b0|i0|c0|p34;R=" (rtos r 2 2) "\\P\\C1You can put here other value}")) (vla-put-layer nw_obj (getvar "CLAYER")) (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car ptlst) (cadddr ptlst)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) (vla-update nw_obj) ) (defun c:rad2lead ( / ent dxf_ent typ_ent mkv vector vlaobj prm id_rad AcDoc Space ent pt1 pt2 pt x) (while (not (setq ent (entsel "\nSelect a bulge: ")))) (setq typ_ent (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))) (cond ((or (eq typ_ent "ARC") (eq typ_ent "CIRCLE") (eq typ_ent "LWPOLYLINE") (and (eq typ_ent "POLYLINE") (zerop (boole 1 120 (cdr (assoc 70 dxf_ent)))) ) ) (if (or (> (fix (car (trans (cadr ent) 1 0))) 1E6) (> (fix (cadr (trans (cadr ent) 1 0))) 1E6)) (setq mkv T vector (trans (cadr ent) 0 0 T) vlaobj (vlax-ename->vla-object (car ent))) (setq mkv nil) ) (if mkv (vla-move vlaobj (vlax-3d-point (trans (cadr ent) 1 0)) (vlax-3d-point '(0.0 0.0 0.0)))) (setq id_rad (distance '(0 0) (trans (vlax-curve-getsecondderiv (car ent) (setq prm (vlax-curve-getparamatpoint (car ent) (vlax-curve-getclosestpointto (car ent) (if mkv '(0.0 0.0 0.0) (trans (cadr ent) 1 0))) ) ) ) 0 (car ent) T ) ) ) (if mkv (vla-move vlaobj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point vector))) (cond ((not (zerop id_rad)) (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) (setq ent (car ent)) (if (member typ_ent '("POLYLINE" "LWPOLYLINE")) (setq pt1 (vlax-curve-getPointAtParam ent (fix prm)) pt2 (vlax-curve-getPointAtParam ent (1+ (fix prm))) pt (vlax-curve-getPointAtParam ent (+ (fix prm) 0.5)) ) (setq pt1 (vlax-curve-getStartPoint ent) pt2 (vlax-curve-getEndPoint ent) pt (vlax-curve-getPointAtDist ent (* 0.5 (- (vlax-curve-getDistAtPoint ent pt2) (vlax-curve-getDistAtPoint ent pt1)))) ) ) (setq x (* (fix (/ (angle (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) pt) (* 0.125 pi))) 0.125 pi) x (+ x (rem x (* 0.25 pi))) ) (make_mlead pt x id_rad (vlax-ename->vla-object ent)) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) ) (T (princ "\nSegment have no bulge.")) ) ) (T (princ "\nThis object can't be availaible for this function!")) ) (prin1) )

You can use this to obtain for onely one sheet in excel... ; by patrick_35 ; mods by beekeecz and bonuscad ;(sssetfirst nil (ssadd (handent "2F") (ssadd))) (vl-load-com) (defun c:length_curve2xls ( / AcDoc Space ss factor xls wks lin n obj) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (princ "\nSelect objects") (cond ((setq ss (ssget (list '(0 . "*POLYLINE,LINE,ARC,CIRCLE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "<NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") ) ) ) (initget 2) (setq factor (getreal "\nMultiplicative factor to apply to lengths? <1>: ")) (if (not factor) (setq factor 1.0)) (vla-startundomark AcDoc) (setq xls (vlax-get-or-create-object "Excel.Application")) (or (setq wks (vlax-get xls 'ActiveSheet)) (vlax-invoke (vlax-get xls 'workbooks) 'Add) ) (setq wks (vlax-get xls 'ActiveSheet) lin 2 ) (vlax-put xls 'Visible :vlax-true) (vlax-put (vlax-get-property wks 'range "A1") 'value "Handle") (vlax-put (vlax-get-property wks 'range "B1") 'value "Length") (repeat (setq n (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))) (vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (strcat "\"" (vlax-get-property obj 'Handle) "\"") ) (vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (* factor (vlax-get-property obj (cond ((eq (vla-get-ObjectName obj) "AcDbArc") "ArcLength") ((eq (vla-get-ObjectName obj) "AcDbCircle") "Circumference") (T "Length") ) ) ) ) (setq lin (1+ lin)) ) (mapcar 'vlax-release-object (list wks xls)) (gc)(gc) (vla-endundomark AcDoc) ) ) (prin1) ) An if you want to re-labeling your polylines with a field for link with table. (vl-load-com) (defun c:Label_Handle ( / ss htx AcDoc Space n ename obj alpha nw_obj) (princ "\nSelect LWPolylines.") (while (null (setq ss (ssget (list '(0 . "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nAren't LWPolylines!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive the height of the text <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (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) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ename) alpha 0.0 nw_obj (vla-addMtext Space (vlax-3d-point (vlax-curve-GetEndPoint obj)) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID obj)) ">%).Handle \\f \"%tc1\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 (getvar "CLAYER") alpha) ) ) (vla-endundomark AcDoc) (prin1) )

I don't think it's possible to obtain a geometrically correct axis with perpendiculars. Try doing the same thing manually, but with bisectors for each vertex of the two polylines. Extend each bisector to the other polyline and use the midpoints as points for the axis.

@maahee Please upload you sample,dwg . as to test

just another way to get perpendicular lines https://www.youtube.com/watch?v=GHHY5Na2Tgg a bit more work imo because you would have to create circles for each segment to get the intersecting points. and then trim or extend said line to find the mid point between the two polylines used it a couple of times in wood working when I had to cut something in half but didn't want to walk across the shop to get the tap measure.

(defun C:bm () (setvar "osmode" 0) ; Turn off OSNAP (setq obj (ssget '((0 . "LWPOLYLINE,ARC")))) (setq num (sslength obj)) (setq i 0) (repeat num (setq obj1 (ssname obj i)) (setq db (entget obj1)) (if (= (cdr (assoc 0 db)) "ARC") (progn (setq ct (cdr (assoc 10 db))) (setq rd (cdr (assoc 40 db))) (setq ang1 (* (cdr (assoc 50 db)) (/ 180.0 pi)) ang2 (* (cdr (assoc 51 db)) (/ 180.0 pi)) ) (setq p1 (polar ct ang1 rd)) (setq p2 (polar ct ang2 rd)) (command "_.dimradius" "_non" p1 "_non" p2 "") (command "_.dimarc" "_non" p1 "_non" p2 "") ) ;progn (progn ;polyline arc segment ;;;;;code (if (/= bulge 0.0) (progn (setq p1 (nth r ptlist)) (setq p2 (nth (+ r 1) ptlist)) (command "_.dimradius" "_non" p1 "_non" p2 "") (command "_.dimarc" "_non" p1 "_non" p2 "") ; ) ;progn ) ;if ) ;progn ) (setq i (1+ i)) ) ;repeat end ; Turn off OSNAP (setvar "osmode" 511) (princ) ) ;end 1. It does not obtain dimensions for all arc objects. 2. It does not obtain the dimensions of all polyline arc segments. (command "_.dimradius" "_non" p1 "_non" p2 "") (command "_.dimarc" "_non" p1 "_non" p2 "") ;

here's something in Python, if you can find anything in lisp

sample of this import traceback from pyrx import Db, Ed, Ge, Ap, Rx, Gs @Ap.Command() def doit(): try: # select db = Db.curDb() filter = [(Db.DxfCode.kDxfStart, "TEXT,LWPOLYLINE")] ps, ss = Ed.Editor.select(filter) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) texts = [Db.Text(id) for id in ss.objectIds(Db.Text.desc())] plines = [Db.Polyline(id) for id in ss.objectIds(Db.Polyline.desc())] # make kdtree & list of points pntmap = {} plpoints = [] for pl in plines: plpoints.append(pl.getStartPoint()) plpoints.append(pl.getEndPoint()) pntmap[pl.getStartPoint()] = pl pntmap[pl.getEndPoint()] = pl # search closest pline results = [] tree = Ge.Point3dTree(plpoints) for text in texts: idxs, _ = tree.knnSearch(text.position(), 1) pl: Db.Polyline = pntmap[plpoints[idxs[0]]] results.append([text.textString(), pl.getDistAtParam(pl.getEndParam())]) # format mtext results = sorted(results, key=lambda x: int(x[0][2:])) buffer = "{:<6}\t{}\\P".format("S.No", "Length Ft") buffer += "".join(f"{sno:<6}\t {plen:>.2f}\\P" for sno, plen in results) # make mtext, add to currentSpace ps, pnt = Ed.Editor.getPoint("\nPick Text Position") mt = Db.MText() mt.setDatabaseDefaults(db) mt.setLocation(pnt) mt.setContents(buffer) cs = db.currentSpace(Db.OpenMode.kForWrite) cs.appendAcDbEntity(mt) except Exception as err: traceback.print_exception(err)

Can you explain that?