Leaderboard

This is a simple transient effect in visualizing Qdim lines. you can try LM:grtext as well (defun gr-lines (i co pt l / k ip-lst lastp) ;hp 04.05.2020 (defun ip-lst (pt c v1 v2 l) (grvecs (apply 'append (setq l (mapcar '(lambda (p / ip) (if (setq ip (inters pt (mapcar '+ pt v1) p (mapcar '+ p v2) nil ) ) (list c ip p) ) ) l ) ) ) ) (mapcar 'cadr l) ) (while (and pt (setq k (grread t 13 0)) (= (car k) 5) (setq pt (cadr k)) (vl-consp pt) ) (redraw) (cond ((= i 0) (setq l (vl-sort l '(lambda (a b) (< (car a) (car b))))) (grvecs (list co (list (caar l) (cadr pt)) (list (car (last l)) (cadr pt)) ) ) (ip-lst pt co '(1 0 0) '(0 1 0) l) ) ((= i 1) (setq l (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))) (grvecs (list co (list (car pt) (cadar l)) (list (car pt) (cadr (last l))) ) ) (ip-lst pt co '(0 1 0) '(1 0 0) l) ) ((= i 2) (mapcar '(lambda (a b / ip) (if (setq ip (apply 'ip-lst (vl-list* pt co (reverse (cons (list a b) (mapcar '(lambda (x) (polar '(0 0 0) (+ x (angle a b)) 1)) (list (/ pi 2) 0) ) ) ) ) ) ) (apply 'grdraw (append ip (list co))) ) ) l (cdr l) ) ) ) (setq lastp pt) ) lastp ) Try to modify add function call in original code in red (if ,and ,progn, else) ;;<snippets>;; (if (and ;;<snippets>;; (setq pt (getpoint "\nSpecify dimension line location: ")) ;; ignore this line within 'and' ;;<snippets>;; ) (progn ;;add this as new (setq pts (mapcar '(lambda (x) (trans x 0 1)) pts) pt (gr-lines (vl-position *DimTypeBDA '("Horizontal" "Vertical" "Aligned")) 4 (getvar 'viewctr) pts ) ) ;setq (repeat (1- (length pts)) ;;<snippets>;; unchanged ) ;repeat ) ; end of progn (princ (strcat "\nError: Wrong selection of at least 2 BLOCKS.")) ;else ) ; end of if ;;<snippets>;;

@Tharwat Perhaps a bit simpler? ( based on example drawing ) (defun cmts (str) (if (and (wcmatch str "*{*;*}") (setq str (substr str (+ 2 (vl-string-position (ascii ";") str 0 t)))) ) (substr str 1 (vl-string-position (ascii "}") str)) str ) )

Excellent, you are welcome anytime.

Now is perfect! wow...you didn't stop until you totally solved the problem! You are a great men Thank you very much

Thanks Ron. @carmelo Please try the following expanded codes to get the job done the way it should be. (defun c:foo (/ a e) (if (and (setq a (car (entsel "\nSelect text : "))) (or (wcmatch (cdr (assoc 0 (setq e (entget a)))) "TEXT,MTEXT") (alert "Invlaid object. Try again") ) (or (numberp (setq a (distof (Clear_Mtext_String (cdr (assoc 1 e))))) ) (alert "Invalid contents of text <!>") ) ) (princ (/ a 8.0)) ) (princ) ) ;; ;; (defun Clear_Mtext_String (String / Text Str) (setq Text "") (while (/= String "") (cond ((wcmatch (strcase (substr String 1 6)) "\\PXQC;") (setq String (substr String 7)) ) ((wcmatch (strcase (setq Str (substr String 1 2))) "\\[\\{}`~]" ) (setq String (substr String 3) Text (strcat Text Str) ) ) ((wcmatch (substr String 1 1) "[{}]") (setq String (substr String 2)) ) ((and (wcmatch (strcase (substr String 1 2)) "\\P") (/= (substr String 3 1) " ") ) (setq String (substr String 3) Text (strcat Text " ") ) ) ((wcmatch (strcase (substr String 1 2)) "\\[LOP]") (setq String (substr String 3)) ) ((wcmatch (strcase (substr String 1 2)) "\\[ACFHQTW]") (setq String (substr String (+ 2 (vl-string-search ";" String)))) ) ((wcmatch (strcase (substr String 1 2)) "\\S") (setq Str (substr String 3 (- (vl-string-search ";" String) 2)) Text (strcat Text (vl-string-translate "#^\\" " " Str)) String (substr String (+ 4 (strlen Str))) ) (print Str) ) (T (setq Text (strcat Text (substr String 1 1)) String (substr String 2) ) ) ) ) Text ) (vl-load-com)

As Tharwat eluded ... (1 . "\\pxqc;{\\fArial|b0|i0|c0|p34;1}")

Can you upload a sample of that drawing that you tested the routine on including the same Mtext that the codes failed with as you previously demonstrated? Please save the drawing to AutoCAD 2016 or earlier for me to be able to open the drawing.

You're welcome anytime. Yes it is possible unless you have your Mtext contents formatted then you would be in need of unformatting the contents in prior of retrieving the value. But anyway, just replace the following expression: (= (cdr (assoc 0 (setq e (entget a)))) "TEXT") With this expression. (wcmatch (cdr (assoc 0 (setq e (entget a)))) "TEXT,MTEXT")

Just expanding a bit more in case any more than / 8. Can just type on command line (foo number). (defun foo ( div / a e) (if (and (setq a (car (entsel "\nSelect text : "))) (or (= (cdr (assoc 0 (setq e (entget a)))) "TEXT") (alert "Invlaid object. Try again") ) (or (numberp (setq a (distof (cdr (assoc 1 e))))) (alert "Invalid contents of text <!>") ) ) (princ (/ a div)) ) (princ) ) (defun c:foo8 () (foo 8.0) (princ) ) (defun c:foo4 () (foo 4.0) (princ) )

See the answer here and let me know if it's what you want.

Note that bulge /= angle, and therefore this will yield unexpected results as the cursor moves around the vertices. Instead, you might consider calculating the bulge in the following way, exploiting the inscribed angle theorem: (defun c:test ( / a1 ex gr p1 p2 zv ) (setq zv (trans '(0 0 1) 1 0 t)) (if (setq p1 (getpoint "\nSpecify first point: ")) (progn (while (setq p2 (getpoint p1 "\nSpecify next point: ")) (setq ex (entget (entmakex (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(090 . 2) '(070 . 0) (cons 010 (trans p1 1 zv)) (cons 010 (trans p2 1 zv)) (cons 210 zv) ) ) ) ) (while (= 5 (car (setq gr (grread t 13 0)))) (setq a1 (/ (- (angle (cadr gr) p2) (angle p1 (cadr gr))) 2)) (entmod (subst (cons 42 (/ (sin a1) (cos a1))) (assoc 42 ex) ex)) ) (setq p1 p2) ) ) ) (princ) )

Here's my complete solution for you: (defun c:tracepoly (/ *error* 05pi 135deg 15pi 225deg acadobj activeundo adoc angpl arrowhead_size arrpl coords DegToRad dist endpt gr grp grplpt grv lastpt maxlen maxpt midpt msp pl pt pts txt) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (defun midpt (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2))) ; <--- Not applicable for 3D space (defun DegToRad (ang) (* (/ pi 180) ang)) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (setq arrowhead_size 125) ; <--- Set arrowhead size here (if (and (setq dist (progn (initget 6) (getdist "\nSpecify maximum distance: "))) (setq pt (getpoint "\nSpecify start point: ")) ) (progn (entmake (list '(0 . "CIRCLE") (cons 10 pt) '(40 . 100) ) ) (setq pl (vlax-ename->vla-object (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(6 . "DASHED2") '(48 . 0.2) '(90 . 2) '(70 . 0) '(43 . 50.0) (cons 10 pt) '(40 . 50.0) '(41 . 50.0) '(42 . 0.0) '(91 . 0) (cons 10 (polar pt 0 1)) '(40 . 50.0) '(41 . 50.0) '(42 . 0.0) '(91 . 0) ) ) ) arrpl (vlax-ename->vla-object (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(6 . "DASHED2") '(48 . 0.2) '(90 . 2) '(70 . 0) '(43 . 50.0) (cons 10 pt) '(40 . 50.0) '(41 . 50.0) '(42 . 0.0) '(91 . 0) (cons 10 (polar pt 0 1)) '(40 . 50.0) '(41 . 50.0) '(42 . 0.0) '(91 . 0) ) ) ) txt (vla-AddText msp "1m" (vlax-3d-point pt) 200) pts (vlax-get pl 'Coordinates) coords (list (car pts) (cadr pts)) lastpt (list (caddr pts) (cadddr pts)) 05pi (* 0.5 pi) 15pi (* 1.5 pi) 135deg (DegToRad 135) 225deg (DegToRad 225) ) (vla-put-Alignment txt acAlignmentMiddle) (while (progn (setq gr (grread t 15 0) grp (last gr) grv (car gr) ) (cond ((= grv 5) (setq grplpt (list (car grp) (cadr grp)) angpl (angle lastpt grp) ) (vlax-put pl 'Coordinates (append coords grplpt)) (if (> (setq maxlen (vla-get-Length pl)) dist) (progn (setq maxpt (vlax-curve-getPointAtDist pl dist)) (vlax-put pl 'Coordinates (append coords (list (car maxpt) (cadr maxpt)))) ) ) (setq endpt (vlax-curve-getEndPoint pl)) (vlax-put arrpl 'Coordinates (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x)) ) (list (polar endpt (+ angpl 135deg) arrowhead_size) endpt (polar endpt (+ angpl 225deg) arrowhead_size) ) ) ) ) (vla-put-TextString txt (strcat (rtos (vla-get-Length pl) 2 1) "m")) (vla-put-TextAlignmentPoint txt (vlax-3d-point (polar (midpt lastpt endpt) (+ 05pi angpl) 200 ) ) ) (vla-put-Rotation txt (+ angpl (if (<= 05pi angpl 15pi) pi 0))) T ) ((and (= grv 2) (vl-position grp '(13 32))) nil) ((= grv 3) (setq coords (append coords grplpt) lastpt grplpt ) (< maxlen dist) ) (T) ) ) ) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) )