All Activity
- Past hour
-
wobo joined the community
-
menakerelous joined the community
- Today
-
adel ahmed hagras joined the community
-
Saxlle started following Extract Polyline Lengths with Associated Text Labels in AutoCAD
-
Extract Polyline Lengths with Associated Text Labels in AutoCAD
Saxlle replied to Tamim's topic in AutoLISP, Visual LISP & DCL
@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.
-
Danielm103 started following Hybrid parallel
-
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
- Yesterday
-
No, the program is required to define the reactors used to update the textbox position.
-
Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD
Danielm103 replied to Danielm103's topic in .NET, ObjectARX & VBA
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 -
Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD
Danielm103 replied to Danielm103's topic in .NET, ObjectARX & VBA
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 -
Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD
BIGAL replied to Danielm103's topic in .NET, ObjectARX & VBA
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. -
Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD
Danielm103 replied to Danielm103's topic in .NET, ObjectARX & VBA
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 -
Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD
BIGAL replied to Danielm103's topic in .NET, ObjectARX & VBA
Would a table answer be perhaps neater than Mtext ? Just ask for text size for table. -
Gabriel Paixão joined the community
-
I am trying to adapt an AutoLISP that automates the creation of fields linked to polyline areas. My goal is that based on a layer pre-established by the user, the program creates an MTEXT with a field linked to the area at its center for all closed polylines. Código original: My adapt: (defun c:A2FL ( / *error* fmt targetLayer allPolylines filteredSel idx ename obj str minPt maxPt minX minY maxX maxY centerPnt ) ;; Define the default formatting string for the Field. ;; "%lu6%qf1" generally means length units with 6 decimal places and zero suppression. ;; You can adjust this according to your needs (e.g., "%lu2%qf1" for 2 decimal places). (setq fmt "%lu6%qf1") ;; --- Local Error Handler for A2FL Command --- (defun *error* ( msg ) (LM:endundo (LM:acdoc)) ;; Ensures that the UNDO group is closed (if (not (wcmatch (strcase msg T) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ;; Displays the error message (unless it's a user interruption) ) (princ) ;; Suppresses the output of the last evaluated value ) (princ "\n--- Command: A2FL (Individual Polyline Areas by Layer) ---") ;; --- Step 1: Request Target Layer Name from User --- (setq targetLayer (getstring T "\nPlease enter the layer name for closed polylines: ")) ;; Check if the layer name was provided. (if (= "" targetLayer) (progn (princ "\nLayer name cannot be empty. Exiting 'A2FL'.") (exit) ;; Aborts command execution ) ) ;; Convert the layer name to uppercase to ensure case-insensitive comparison. (setq targetLayer (strcase targetLayer)) ;; --- Step 2: Automatically Select and Filter Closed Polylines in Target Layer --- ;; 'ssget "_X"' selects all entities in the drawing. ;; The filter '((0 . "*POLYLINE"))' restricts the initial selection to polylines only (2D, 3D and Lightweight). (setq allPolylines (ssget "_X" '((0 . "*POLYLINE")))) ;; Initialize an empty selection set to store only the filtered polylines. (setq filteredSel (ssadd)) ;; If there are polylines in the drawing to check: (if allPolylines (progn ;; Iterate over each polyline in the 'allPolylines' selection. (repeat (setq idx (sslength allPolylines)) (setq ename (ssname allPolylines (setq idx (1- idx)))) ;; Get the entity name (setq obj (vlax-ename->vla-object ename)) ;; Convert entity name to VLA object ;; Check if the polyline is in the target layer AND if it is closed. (if (and (= (strcase (vla-get-layer obj)) targetLayer) (eq :vlax-true (vla-get-closed obj)) ) (ssadd ename filteredSel) ;; Add the polyline to our filtered selection set ) ) ) ) ;; --- Step 3: Check if Any Suitable Polyline Was Found --- ;; If the 'filteredSel' selection set is empty after filtering: (if (zerop (sslength filteredSel)) (progn (princ (strcat "\nNo closed polylines found in layer '" targetLayer "'. Exiting 'A2FL'.")) (exit) ;; Aborts command execution ) ) (LM:startundo (LM:acdoc)) ;; Start an UNDO group so all operations can be easily undone. ;; --- Step 4: Process Each Filtered Polyline --- (repeat (setq idx (sslength filteredSel)) (setq ename (ssname filteredSel (setq idx (1- idx)))) ;; Get the entity name of current polyline (setq obj (vlax-ename->vla-object ename)) ;; Convert to VLA object ;; --- 4.1: Calculate the Central Point (approximate) for MText --- ;; We use the bounding box of the polyline to find an approximate center. ;; For complex or concave polylines, this point may not be "inside" the geometry, ;; but it's a simple and generally effective method for text placement. (vla-GetBoundingBox obj 'minPt 'maxPt) ;; Get the minimum and maximum corners of the bounding box (setq minX (vlax-safearray-get-element minPt 0) minY (vlax-safearray-get-element minPt 1) maxX (vlax-safearray-get-element maxPt 0) maxY (vlax-safearray-get-element maxPt 1) ) ;; Calculate the midpoint of the bounding box. (setq centerPnt (list (/ (+ minX maxX) 2.0) (/ (+ minY maxY) 2.0) 0.0)) ;; Z always 0 for 2D ;; --- 4.2: Build the Field Expression String for Current Polyline --- ;; This string is the same used for a single object in the original 'A2F' command, ;; ensuring correct field interpretation by AutoCAD. (setq str (strcat "%<\AcObjProp Object(%<_ObjId " (LM:ObjectID obj) ;; Use the ID of the *current* polyline ">%).Area \f "" fmt "">%" ) ) ;; --- 4.3: Create and Insert the MText Object in the Drawing --- ;; The MText is always added to Modelspace in this command, at the calculated center point. (vla-addmtext (vlax-get-property (LM:acdoc) 'modelspace) ;; Add to Modelspace (vlax-3D-point centerPnt) ;; Insertion point (the centroid) 0.0 ;; Text height (uses default height or annotative scale) str ;; The generated field string ) ) (LM:endundo (LM:acdoc)) ;; End the UNDO group. (princ (strcat "\nCommand 'A2FL' completed. " (itoa (sslength filteredSel)) " area fields inserted.")) (princ) ;; Suppress the output of the last evaluated value in the command line. ) ;; The auxiliary functions (LM:ObjectID, LM:getcell, LM:startundo, LM:endundo, LM:acdoc) ;; and COM loading (vl-load-com) (princ) are assumed to be already defined ;; and available in your original 'Areas2FieldV1-3.txt' file. ;; Do not redefine them here if they are already in the same file.
-
Merge Dimstyle & Text style after removing of binding prefix $0$
LeoManu replied to nababeer's topic in AutoLISP, Visual LISP & DCL
Hi there, It’s been a long time since this post, but I’m trying to do the same thing and I’m having trouble merging all the text styles. Here’s some progress on the routine that fixes the ActiveX server returned an error: type mismatch! error. thanks to komondormrex. However, I still can’t merge all the text styles. I’m attaching a sample file. Cheers! (defun c:mergedimtxt (/ cmd doc pos str) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (foreach col '(textstyles dimstyles) (mergedimtxt:processcollection (vlax-get-property doc col)) ) (vlax-for blk (vla-get-blocks doc) (if (= :vlax-false (vla-get-isxref blk)) (vlax-for obj blk (if (and (wcmatch (vla-get-objectname obj) "AcDb*Text,AcDb*Dimension") (setq str (vla-get-stylename obj) pos (vl-string-position 36 str nil t) ) (vlax-write-enabled-p obj) ) (vla-put-stylename obj (substr str (+ 2 pos))) ) ) ) ) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (setvar 'textstyle "Standard") (command "_.-dimstyle" "_r" "Standard" "_.-purge" "_r" "*" "_n" "_.-purge" "_a" "*" "_n") (setvar 'cmdecho cmd) (vla-regen doc acAllViewports) (princ) ) (defun mergedimtxt:processcollection (col / pos str obj_dxf) (vlax-for obj col (if (and (setq str (vla-get-name obj) pos (vl-string-position 36 str nil t) ) (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list col (substr str (+ 2 pos)))) ) ) (entmod (subst (cons 2 (substr str (+ 2 pos))) (assoc 2 (setq obj_dxf (entget (vlax-vla-object->ename obj)))) obj_dxf)) ;komondormrex ) ) ) (vl-load-com) (princ) Drawing6.dwg -
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) )
-
dannonino joined the community
-
Associative Textbox (Lee Mac)
sachindkini replied to sachindkini's topic in AutoLISP, Visual LISP & DCL
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.. -
Associative Textbox (Lee Mac)
sachindkini replied to sachindkini's topic in AutoLISP, Visual LISP & DCL
thanks sir, its perfect -
Lee Mac started following Associative Textbox (Lee Mac)
-
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!
-
BlackBox started following PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
BlackBox replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/performance-issue-with-read-line-on-large-csv-files/td-p/13865858 -
sachindkini started following Associative Textbox (Lee Mac)
-
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) )
-
Extract Polyline Lengths with Associated Text Labels in AutoCAD
Tsuky replied to Tamim's topic in AutoLISP, Visual LISP & DCL
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.
-
devitg started following Dimensions
-
@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 "") ;
-
Danielm103 started following Extract Polyline Lengths with Associated Text Labels in AutoCAD
-
Extract Polyline Lengths with Associated Text Labels in AutoCAD
Danielm103 replied to Tamim's topic in AutoLISP, Visual LISP & DCL
here's something in Python, if you can find anything in lisp
