smitaranjan Posted December 16, 2022 Posted December 16, 2022 (edited) I want to put station marking for my job like the attached screenshot...I found a lisp code online which put station marking but its doing with interval which i don't want...i want to put station mark at my desired points...how can i modify? I have no idea...please help (DEFUN C:SM() (RDInput1) (RDSA) ) (defun C:RDS1() (RDSA) ) (defun RDSA () (setq cmdold (getvar "cmdecho")) (setvar "cmdecho" 0) (setq osmold (getvar "osmode")) (setvar "osmode" 0) (princ) (terpri) (setq sst nil) (while (= sst nil) (setq sst (entsel "\nSelect Polyline/ Line for Marking RDs")) ) (setq RD (+ RD rdi)) ; First Value (COMMAND "MEASURE" sst "B" rdmB "" mdi) (COMMAND "MEASURE" sst "B" "RD" "" rdii) (setq SSET (ssget "P")) (setq COUNT 0) (while (< COUNT (sslength SSET)) (setq A1 (ssname SSET count)) (setq A2 (entget A1)) (setq A3 (cdr (assoc 0 A2))) (if (= A3 "INSERT") (progn (setq A4 (assoc 10 A2)) (setq A5 (cdr A4)) (command "EXPLODE" a1) (SETQ X1 (ENTGET(ENTLAST))) (SETQ X2 (ASSOC 1 X1)) (SETQ X3 (CDR X2)) (SETQ RD5 (RTOS RD 2 0)) ;(setq B1 (strcat "(" X3 ")")) ;(setq B1 (strcat RD5 "+000")) (setq RDtxt RD5) (text1) (setq B1 RDtext) (setq B2 (cons 1 B1)) ;(setq A2 (subst B2 A4 A2)) (setq A2 (subst B2 X2 X1)) ;(command "DDEDIT" "L" "") (entmod A2) (SETQ RD5 (ATOF RD5)) (SETQ RD (+ RD5 rdi)) );Progn );if (setq count (+ 1 count)) );while (setvar "cmdecho" cmdold) (setvar "osmode" osmold) (terpri) (princ (strcat " RD = " (rtos rd 2 0))) (terpri) );defun (defun text1 (/ abs2 rem1) (if (and (= (strlen RDtxt) 1) (= RDtxt "0")) (Progn (setq RDtxt "0000")) (progn (if (and (> (strlen RDtxt) 1) (<= (strlen RDtxt) 3)) (setq RDtxt (strcat "0" RDtxt))) )) (setq abs2 (substr RDtxt 1 (- (strlen RDtxt) 3))) (setq rem1 (substr RDtxt (+ (strlen abs2) 1))) (setq RDtext (strcat abs2 "+" rem1)) ) (defun c:RDInput () (RDInput1) ) (defun c:RD () (RD1) ) (defun c:RDI() (RDI1) ) (defun c:RDM() (RDM1) ) (defun c:RDMB() (RDMB1) ) (defun c:SF() (SF1) ) (defun RDInput1 () (SF1) ; Scale Factor (RD1) ; RD # and block (RDblk) (RDI1) ; RD interval (RDM1) ; RD marker Interval (RDMB1) ; RD marker block name ) (defun RD1 (/ RD1) (if (= RD nil) (setq RD 0)) (setq RD1 (getreal (strcat "\nStart RD # [" (rtos RD 2 0) "] :"))) (if (/= RD1 nil) (setq RD RD1)) (princ (strcat "RD = " (rtos rd 2 0))) (terpri) ) (defun RDI1(/ rdiA) (if (= rdi nil) (setq rdi 250)) (setq rdiA (getreal (strcat "\nRD # Interval [" (rtos RDi 2 0) "] :"))) (if (/= rdiA nil) (setq rdi rdiA)) (princ (strcat "RD Intr = " (rtos rdi 2 0))) (terpri) (setq rdii (* rdi ssf)) ) (defun RDM1(/ mdA) (if (= md nil) (setq md 250)) (setq mdA (getreal (strcat "\nRD Marker Distance [" (rtos md 2 0) "] :" ))) (if (/= mdA nil) (setq md mdA)) (if (> md rdi) (setq md rdi)) (princ (strcat "RD marker Dist = " (rtos md 2 0))) (terpri) (setq mdi (* md ssf)) ) (defun RDMB1() (if (= rdmB nil) (setq rdmB " ")) (setq rdmB (getstring (strcat "\nBranch/ Distributary Name for RD Marking [" rdmB "]:"))) (while (equal rdmB "") (setq rdmB (getstring (strcat "\nBranch/ Distributary Name for RD Marking [" rdmB "]:")))) (princ (strcat "RD marker Blk = " rdmB)) (RDmarker) ; RD marker Block ) (defun SF1(/ ssf1) (if (= ssf nil) (setq ssf 1.0)) (setq ssf1 (getreal (strcat "\nSheet Scale Factor [" (rtos ssf 2 8) "] :"))) (if (/= ssf1 nil) (setq ssf ssf1)) (princ (strcat "Sheet Scale Factor = " (rtos ssf 2 8))) (terpri) ) (defun RDblk(/ sl curlyr osmold list1) (setvar "cmdecho" 0) (setq osmold (getvar "osmode")) (setvar "osmode" 0) (setq curLyr (getvar "clayer")) (command "layer" "thaw" "0" "set" "0" "on" "0" "") (if (equal (tblsearch "block" "RD") nil) (progn (command "zoom" "e") (command "style" "TNR" "Times New Roman" "0.0" "1.0" "0" "N" "N") (command "color" "bylayer") (command "TEXT" "S" "TNR" "J" "ML" "0,0" "15.50" "90" "0+000") ;(setq list1 (list (cons 0 "TEXT") (cons 40 15.50) (cons 1 "0+000"))) (setq list1 (list (cons 0 "TEXT")(cons 1 "0+000"))) (setq sl (ssget "l" list1)) (command "block" "RD" "0,15.0" sl "") ; (command "erase" sl "") )) (setvar "osmode" osmold) ;(command "layer" "set" curlyr "on" curlyr "") (command "zoom" "p") ) (defun RDmarker(/ sl1 osmold list1) (setvar "cmdecho" 0) (setq osmold (getvar "osmode")) (setvar "osmode" 0) ;(setq curLyr (getvar "clayer")) (if (equal (tblsearch "block" rdmB) nil) (progn (command "zoom" "e") (command "color" "bylayer") (command "line" "0,0" "0,7.0" "") (setq list1 (list (cons 0 "LINE") (cons 10 (list 0.0 0.0 0.0)) (cons 11 (list 0.0 7.0 0.0)))) (setq sl1 (ssget "l" list1)) (command "block" rdmB "0,0" sl1 "") ; (command "erase" sl "") )) (setvar "osmode" osmold) (command "layer" "set" curlyr "on" curlyr "") (command "zoom" "p") ) (princ) Edited December 16, 2022 by SLW210 Added Code Tags!! Quote
devitg Posted December 16, 2022 Posted December 16, 2022 4 hours ago, smitaranjan said: I want to put station marking for my job like the attached screenshot...I found a lisp code online which put station marking but its doing with interval which i don't want...i want to put station mark at my desired points...how can i modify? I have no idea...please help (DEFUN C:SM() (RDInput1) (RDSA) ) (defun C:RDS1() (RDSA) ) (defun RDSA () (setq cmdold (getvar "cmdecho")) (setvar "cmdecho" 0) (setq osmold (getvar "osmode")) (setvar "osmode" 0) (princ) (terpri) (setq sst nil) (while (= sst nil) (setq sst (entsel "\nSelect Polyline/ Line for Marking RDs")) ) (setq RD (+ RD rdi)) ; First Value (COMMAND "MEASURE" sst "B" rdmB "" mdi) (COMMAND "MEASURE" sst "B" "RD" "" rdii) (setq SSET (ssget "P")) (setq COUNT 0) (while (< COUNT (sslength SSET)) (setq A1 (ssname SSET count)) (setq A2 (entget A1)) (setq A3 (cdr (assoc 0 A2))) (if (= A3 "INSERT") (progn (setq A4 (assoc 10 A2)) (setq A5 (cdr A4)) (command "EXPLODE" a1) (SETQ X1 (ENTGET(ENTLAST))) (SETQ X2 (ASSOC 1 X1)) (SETQ X3 (CDR X2)) (SETQ RD5 (RTOS RD 2 0)) ;(setq B1 (strcat "(" X3 ")")) ;(setq B1 (strcat RD5 "+000")) (setq RDtxt RD5) (text1) (setq B1 RDtext) (setq B2 (cons 1 B1)) ;(setq A2 (subst B2 A4 A2)) (setq A2 (subst B2 X2 X1)) ;(command "DDEDIT" "L" "") (entmod A2) (SETQ RD5 (ATOF RD5)) (SETQ RD (+ RD5 rdi)) );Progn );if (setq count (+ 1 count)) );while (setvar "cmdecho" cmdold) (setvar "osmode" osmold) (terpri) (princ (strcat " RD = " (rtos rd 2 0))) (terpri) );defun (defun text1 (/ abs2 rem1) (if (and (= (strlen RDtxt) 1) (= RDtxt "0")) (Progn (setq RDtxt "0000")) (progn (if (and (> (strlen RDtxt) 1) (<= (strlen RDtxt) 3)) (setq RDtxt (strcat "0" RDtxt))) )) (setq abs2 (substr RDtxt 1 (- (strlen RDtxt) 3))) (setq rem1 (substr RDtxt (+ (strlen abs2) 1))) (setq RDtext (strcat abs2 "+" rem1)) ) (defun c:RDInput () (RDInput1) ) (defun c:RD () (RD1) ) (defun c:RDI() (RDI1) ) (defun c:RDM() (RDM1) ) (defun c:RDMB() (RDMB1) ) (defun c:SF() (SF1) ) (defun RDInput1 () (SF1) ; Scale Factor (RD1) ; RD # and block (RDblk) (RDI1) ; RD interval (RDM1) ; RD marker Interval (RDMB1) ; RD marker block name ) (defun RD1 (/ RD1) (if (= RD nil) (setq RD 0)) (setq RD1 (getreal (strcat "\nStart RD # [" (rtos RD 2 0) "] :"))) (if (/= RD1 nil) (setq RD RD1)) (princ (strcat "RD = " (rtos rd 2 0))) (terpri) ) (defun RDI1(/ rdiA) (if (= rdi nil) (setq rdi 250)) (setq rdiA (getreal (strcat "\nRD # Interval [" (rtos RDi 2 0) "] :"))) (if (/= rdiA nil) (setq rdi rdiA)) (princ (strcat "RD Intr = " (rtos rdi 2 0))) (terpri) (setq rdii (* rdi ssf)) ) (defun RDM1(/ mdA) (if (= md nil) (setq md 250)) (setq mdA (getreal (strcat "\nRD Marker Distance [" (rtos md 2 0) "] :" ))) (if (/= mdA nil) (setq md mdA)) (if (> md rdi) (setq md rdi)) (princ (strcat "RD marker Dist = " (rtos md 2 0))) (terpri) (setq mdi (* md ssf)) ) (defun RDMB1() (if (= rdmB nil) (setq rdmB " ")) (setq rdmB (getstring (strcat "\nBranch/ Distributary Name for RD Marking [" rdmB "]:"))) (while (equal rdmB "") (setq rdmB (getstring (strcat "\nBranch/ Distributary Name for RD Marking [" rdmB "]:")))) (princ (strcat "RD marker Blk = " rdmB)) (RDmarker) ; RD marker Block ) (defun SF1(/ ssf1) (if (= ssf nil) (setq ssf 1.0)) (setq ssf1 (getreal (strcat "\nSheet Scale Factor [" (rtos ssf 2 8) "] :"))) (if (/= ssf1 nil) (setq ssf ssf1)) (princ (strcat "Sheet Scale Factor = " (rtos ssf 2 8))) (terpri) ) (defun RDblk(/ sl curlyr osmold list1) (setvar "cmdecho" 0) (setq osmold (getvar "osmode")) (setvar "osmode" 0) (setq curLyr (getvar "clayer")) (command "layer" "thaw" "0" "set" "0" "on" "0" "") (if (equal (tblsearch "block" "RD") nil) (progn (command "zoom" "e") (command "style" "TNR" "Times New Roman" "0.0" "1.0" "0" "N" "N") (command "color" "bylayer") (command "TEXT" "S" "TNR" "J" "ML" "0,0" "15.50" "90" "0+000") ;(setq list1 (list (cons 0 "TEXT") (cons 40 15.50) (cons 1 "0+000"))) (setq list1 (list (cons 0 "TEXT")(cons 1 "0+000"))) (setq sl (ssget "l" list1)) (command "block" "RD" "0,15.0" sl "") ; (command "erase" sl "") )) (setvar "osmode" osmold) ;(command "layer" "set" curlyr "on" curlyr "") (command "zoom" "p") ) (defun RDmarker(/ sl1 osmold list1) (setvar "cmdecho" 0) (setq osmold (getvar "osmode")) (setvar "osmode" 0) ;(setq curLyr (getvar "clayer")) (if (equal (tblsearch "block" rdmB) nil) (progn (command "zoom" "e") (command "color" "bylayer") (command "line" "0,0" "0,7.0" "") (setq list1 (list (cons 0 "LINE") (cons 10 (list 0.0 0.0 0.0)) (cons 11 (list 0.0 7.0 0.0)))) (setq sl1 (ssget "l" list1)) (command "block" rdmB "0,0" sl1 "") ; (command "erase" sl "") )) (setvar "osmode" osmold) (command "layer" "set" curlyr "on" curlyr "") (command "zoom" "p") ) (princ) Please Upload your sample.dwg Quote
Tsuky Posted December 16, 2022 Posted December 16, 2022 I have this. (vl-load-com) (defun make_mlead (pt str / tmp ptlst arr nw_obj) (initget 9) (setq tmp (getpoint (trans pt 0 1) "\nLeader position: ") ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0)))) 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;" "STATION BLOCK" "\\P" str "}" ) ) (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 pt) (car (trans tmp 1 0))) (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 draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:chainage&leader ( / js htx AcDoc Space ent perim_obj pt_ref dist_ref nw_pt dist_pt len_vtx pk) (vl-load-com) (princ "\nSelect a curve object where you want make a chainage.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (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) (setq ent (ssname js 0) perim_obj (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) ) (redraw ent 3) (initget 1) (setq pt_ref (getpoint "\nReference point of measure: ") pt_ref (vlax-curve-getClosestPointTo ent (trans pt_ref 1 0)) ) (draw_pt (trans pt_ref 0 1) 1) (setq dist_ref (vlax-curve-getDistAtPoint ent pt_ref)) (while (setq nw_pt (getpoint "\nGive a point on object: ")) (cond ((setq nw_pt (vlax-curve-getClosestPointTo ent (trans nw_pt 1 0))) (draw_pt (trans nw_pt 0 1) 3) (setq dist_pt (vlax-curve-getDistAtPoint ent nw_pt)) (if (> dist_pt dist_ref) (setq len_vtx (- dist_pt dist_ref)) (setq len_vtx (- dist_ref dist_pt)) ) (make_mlead nw_pt (vl-string-subst "+" "." (rtos (/ len_vtx 1000.0) 2 3))) ) ) ) (redraw ent 4) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) (prin1) ) Quote
smitaranjan Posted December 16, 2022 Author Posted December 16, 2022 2 hours ago, Tsuky said: I have this. (vl-load-com) (defun make_mlead (pt str / tmp ptlst arr nw_obj) (initget 9) (setq tmp (getpoint (trans pt 0 1) "\nLeader position: ") ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0)))) 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;" "STATION BLOCK" "\\P" str "}" ) ) (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 pt) (car (trans tmp 1 0))) (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 draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:chainage&leader ( / js htx AcDoc Space ent perim_obj pt_ref dist_ref nw_pt dist_pt len_vtx pk) (vl-load-com) (princ "\nSelect a curve object where you want make a chainage.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (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) (setq ent (ssname js 0) perim_obj (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) ) (redraw ent 3) (initget 1) (setq pt_ref (getpoint "\nReference point of measure: ") pt_ref (vlax-curve-getClosestPointTo ent (trans pt_ref 1 0)) ) (draw_pt (trans pt_ref 0 1) 1) (setq dist_ref (vlax-curve-getDistAtPoint ent pt_ref)) (while (setq nw_pt (getpoint "\nGive a point on object: ")) (cond ((setq nw_pt (vlax-curve-getClosestPointTo ent (trans nw_pt 1 0))) (draw_pt (trans nw_pt 0 1) 3) (setq dist_pt (vlax-curve-getDistAtPoint ent nw_pt)) (if (> dist_pt dist_ref) (setq len_vtx (- dist_pt dist_ref)) (setq len_vtx (- dist_ref dist_pt)) ) (make_mlead nw_pt (vl-string-subst "+" "." (rtos (/ len_vtx 1000.0) 2 3))) ) ) ) (redraw ent 4) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) (prin1) ) thanks for replying...its working but I want it to show like 88' = 0+88 145'= 1+45 1256'=12+56 it should calculate distance aligned way of that line,,,,and want to remove that leader Quote
BIGAL Posted December 17, 2022 Posted December 17, 2022 This task has been asked many times I would Google "label chainage autocad lisp" there should be one already done that is what you want. Quote
Tsuky Posted December 17, 2022 Posted December 17, 2022 (edited) With minor adjustments (vl-load-com) (defun make_mtext (pt alpha str / nw_obj) (vla-addLine Space (vlax-3d-point (polar pt alpha (* 0.5 (getvar "TEXTSIZE")))) (vlax-3d-point (polar pt (+ alpha pi) (* 0.5 (getvar "TEXTSIZE")))) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt alpha (getvar "TEXTSIZE")))) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" str "}" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'InsertionPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation) (list 4 pt (getvar "TEXTSIZE") 5 "Standard" (getvar "CLAYER") alpha) ) ) (defun draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:chainage&Mtext ( / js htx AcDoc Space ent perim_obj pt_ref ref_chain dist_ref nw_pt ang dist_pt len_vtx pk) (vl-load-com) (princ "\nSelect a curve object where you want make a chainage.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (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) (setq ent (ssname js 0) perim_obj (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) ) (redraw ent 3) (initget 1) (setq pt_ref (getpoint "\nReference point of measure: ") pt_ref (vlax-curve-getClosestPointTo ent (trans pt_ref 1 0)) ref_chain (getstring "\nStart at? <0+00>: ") ) (if (eq ref_chain "") (setq ref_chain 0.0) (setq ref_chain (atof (vl-string-subst "." "+" ref_chain)))) (draw_pt (trans pt_ref 0 1) 1) (setq dist_ref (vlax-curve-getDistAtPoint ent pt_ref)) (while (setq nw_pt (getpoint "\nGive a point on object: ")) (cond ((setq nw_pt (vlax-curve-getClosestPointTo ent (trans nw_pt 1 0))) (draw_pt (trans nw_pt 0 1) 3) (setq ang (+ (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent nw_pt))) (* 0.5 pi)) dist_pt (vlax-curve-getDistAtPoint ent nw_pt) ) (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5))) (setq ang (+ ang pi))) (if (> dist_pt dist_ref) (setq len_vtx (- dist_pt dist_ref)) (setq len_vtx (- dist_ref dist_pt)) ) (make_mtext nw_pt ang (vl-string-subst "+" "." (rtos (+ ref_chain (/ len_vtx 1200.0)) 2 2))) ) ) ) (redraw ent 4) (vla-endundomark AcDoc) (prin1) ) Edited December 17, 2022 by Tsuky Code updated Quote
smitaranjan Posted December 17, 2022 Author Posted December 17, 2022 2 hours ago, Tsuky said: With minor adjustments (vl-load-com) (defun make_mtext (pt alpha str / nw_obj) (vla-addLine Space (vlax-3d-point (polar pt alpha (* 0.5 (getvar "TEXTSIZE")))) (vlax-3d-point (polar pt (+ alpha pi) (* 0.5 (getvar "TEXTSIZE")))) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt alpha (getvar "TEXTSIZE")))) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" str "}" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'InsertionPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation) (list 4 pt (getvar "TEXTSIZE") 5 "Standard" (getvar "CLAYER") alpha) ) ) (defun draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:chainage&Mtext ( / js htx AcDoc Space ent perim_obj pt_ref dist_ref nw_pt ang dist_pt len_vtx pk) (vl-load-com) (princ "\nSelect a curve object where you want make a chainage.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (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) (setq ent (ssname js 0) perim_obj (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) ) (redraw ent 3) (initget 1) (setq pt_ref (getpoint "\nReference point of measure: ") pt_ref (vlax-curve-getClosestPointTo ent (trans pt_ref 1 0)) ) (draw_pt (trans pt_ref 0 1) 1) (setq dist_ref (vlax-curve-getDistAtPoint ent pt_ref)) (while (setq nw_pt (getpoint "\nGive a point on object: ")) (cond ((setq nw_pt (vlax-curve-getClosestPointTo ent (trans nw_pt 1 0))) (draw_pt (trans nw_pt 0 1) 3) (setq ang (+ (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent nw_pt))) (* 0.5 pi)) dist_pt (vlax-curve-getDistAtPoint ent nw_pt) ) (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5))) (setq ang (+ ang pi))) (if (> dist_pt dist_ref) (setq len_vtx (- dist_pt dist_ref)) (setq len_vtx (- dist_ref dist_pt)) ) (make_mtext nw_pt ang (vl-string-subst "+" "." (rtos (/ len_vtx 100.0) 2 2))) ) ) ) (redraw ent 4) (vla-endundomark AcDoc) (prin1) ) wow...it works perfect...it is showing in inches calculation, how can i change this to feet. And will it take my own value as its for reference point instead of 0+00...that will be helpful....thank you so much Quote
Tsuky Posted December 17, 2022 Posted December 17, 2022 I am not familiar with this measurement system, I mainly work in metrics but I think that the modifications made to the last code posted will meet your expectations. You can also set the start other than 0+00 by default. So reload the previous code... Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.