rrulep Posted July 28, 2014 Share Posted July 28, 2014 Please help me edit this code. It creates chainage along polyline. What I want is to change the "CH 0.00" to the elevation value of the polyline (defun c:cr (/) (vl-load-com) (defun _Line (p b o) (entmake (append '((0 . "line") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TICK") (100 . "AcDbLine") ) (list (cons 10 (polar p b o))) (list (cons 11 (polar p (+ b PI) o))) '((210 0.0 0.0 1.0)) ) ) ) (defun _text (p b o h c) (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o)) ) (list (cons 40 h)) (list (cons 1 (strcat "CH " (if (setq ld (nth (strlen (rtos c 3 0)) '(x ""))) ld "") (rtos c 2 2)))) (list (cons 50 (+ b PI))) (list '(41 . 0) '(90 . 3) '(63 . 256) '(441 . 3935927) '(71 . 4) '(72 . 5) (cons 7 (getvar "textstyle")) '(210 0.0 0.0 1.0) '(73 . 1) ) ) ) ) (defun _ang (p1 p2)(+ (angle p1 p2) (/ PI 2.0))) (setq dist (getdist "increment: ")) (setq offset (getdist "tick size: ")) (setq height (getdist "text height: ")) (setq to (getdist "text offset: ")) (setq ss (ssget) count 0 dist dist offset offset height height ) (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage dist ) (_line (setq p (vlax-curve-getstartpoint obj)) (setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))) offset) (_text p bearing to height 0.0) (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) (setq bearing (+ (angle point1 point2) (/ PI 2.0))) (_line point1 bearing offset) (_text point1 bearing to height chainage) (setq chainage (+ chainage dist)) ) (setq count (1+ count)) ) ) Quote Link to comment Share on other sites More sharing options...
MSasu Posted July 29, 2014 Share Posted July 29, 2014 To get the elevations instead, please adjust these lines: ... (list (cons 1 (strcat [color=magenta][s]"CH "[/s][/color]"EL " ... (_text p bearing to height [color=magenta][s]0.0[/s][/color](caddr p)) ... (_text point1 bearing to height [color=magenta][s]chainage[/s][/color](caddr point1)) ... It would be courteous to specify the autor of the tool if wasn't developed by you. Quote Link to comment Share on other sites More sharing options...
rrulep Posted July 31, 2014 Author Share Posted July 31, 2014 Hi mircea. Thanks for your help. Can you help me edit this code again? What I want is that when the length of the polyline is less than the increment value entered by the user, text must be located on the midddle of the polyline. Is it possible? ;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:cl (/) (vl-load-com) (defun _text (p b o h c) (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o)) ) (list (cons 40 h)) (list (cons 1 (strcat ""(if (setq ld (nth (strlen (rtos c 2 0)) '(x "")))ld "")(rtos c 2 0))));<--:Elevation Value;;; (list (cons 50 (+ b (/ pi 2))));<--Rotation angle of text;; (list '(41 . 0) '(90 . 3);<-- Mask '(63 . 256);<--Mask '(441 . 3935927);<-- Mask '(71 . 5);<--Justification:Middle Center;; '(72 . 5) (cons 7 (getvar "textstyle"));<--:Current text style;; '(210 0.0 0.0 1.0) '(73 . 3) ) ) ) ) (defun _ang (p1 p2)(+ (angle p1 p2) (/(* 3 PI) 2.0))) (setq dist (cond ((getdist "increment <400>:"))(400)));<--:Contour Label Increment;; (setq offset 0) (setq height 2.5);<--:default text height;; (setq to 0) (setq ss (ssget) count 0 dist dist offset offset height height ) (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage dist) (_text p bearing to height (caddr p)) (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) (setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0))) (_text point1 bearing to height (caddr point1)) (setq chainage (+ chainage dist)) ) (setq count (1+ count)) ) ) Quote Link to comment Share on other sites More sharing options...
MSasu Posted July 31, 2014 Share Posted July 31, 2014 Please check that bearing variable isn't defined (seems that should contains a rotation). (_text p [color=red]bearing[/color] to height (caddr p)) Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 4, 2014 Author Share Posted August 4, 2014 I think it is defined here. (setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0))) Please check that bearing variable isn't defined (seems that should contains a rotation). (_text p [color=red]bearing[/color] to height (caddr p)) Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted August 4, 2014 Share Posted August 4, 2014 I think it is defined here. (setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0))) Mircea is correct. your (setq bearing...) is inside while loop ,but (_text p bearing to height (caddr p)) is before while ;;; (_text p bearing to height (caddr p)) <--- [color="red"]try to remove this line[/color] (while (and ... ... thanx for sharing the code Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 6, 2014 Author Share Posted August 6, 2014 Mircea is correct. your (setq bearing...) is inside while loop ,but (_text p bearing to height (caddr p)) is before while ;;; (_text p bearing to height (caddr p)) <--- [color="red"]try to remove this line[/color] (while (and ... ... thanx for sharing the code (_text p bearing to height (caddr p)) If I remove this line, there is no label created on the starting point of the polyline. see image below the red drawing is created without removing this line (_text p bearing to height (caddr p)) the green drawing is created without this line (_text p bearing to height (caddr p)) I also want to label the end point of the polyline. Can you help me with this? Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted August 6, 2014 Share Posted August 6, 2014 hi rrulep, i wonder how did you get it work without (setp P ... ) until i saw your 1st post so i figured out this p, before while.. (setq [color="red"]p[/color] (vlax-curve-getstartpoint obj) bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) (_text [color="red"]p[/color] bearing to height 0.0) (while (and ... ... sorry i overlooked Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 6, 2014 Author Share Posted August 6, 2014 hi rrulep, i wonder how did you get it work without (setp P ... ) until i saw your 1st post so i figured out this p, before while.. (setq [color="red"]p[/color] (vlax-curve-getstartpoint obj) bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) (_text [color="red"]p[/color] bearing to height 0.0) (while (and ... ... sorry i overlooked i also realised that the second code that i've posted is incomplete. thanks hanhphuc Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 7, 2014 Author Share Posted August 7, 2014 (edited) hi rrulep, i wonder how did you get it work without (setp P ... ) until i saw your 1st post so i figured out this p, before while.. (setq [color="red"]p[/color] (vlax-curve-getstartpoint obj) bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) (_text [color="red"]p[/color] bearing to height 0.0) (while (and ... ... sorry i overlooked hi hanhphuc Can you check this code. Works fine with me but still need your help guys to improve it. If the length of the polyline is less than the contour interval, it does not create label. ;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:cl (/) (vl-load-com) (defun _text (p b o h c) ;;; modified by pbe to add background mask (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o)) ) (list (cons 40 h)) (list (cons 1 (strcat ""(if (setq ld (nth (strlen (rtos c 2 0)) '(x "")))ld "")(rtos c 2 0)))) (list (cons 50 (+ b (/ pi 2)))) (list '(41 . 0) '(90 . 3);<-- Mask '(63 . 256);<--Mask '(441 . 3935927);<-- Mask '(71 . 5) '(72 . 5) (cons 7 (getvar "textstyle")) '(210 0.0 0.0 1.0) '(73 . 3) ) ) ) ) (defun _ang (p1 p2)(+ (angle p1 p2) (/(* 3 PI) 2.0))) (setq dist (cond ((getdist "Contour Label Interval <100>:"))(100))) (setq offset 0) (setq height 2.5) (setq to 0) (setq ss (ssget) count 0 dist dist offset offset height height ) (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage dist ) (setq p (vlax-curve-getstartpoint obj)) (setq p2 (vlax-curve-getendpoint obj));;;;added by rrulep to label the end points of polyline (setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))) (_text p bearing to height (caddr p));;;;modified by mircea to get the elevation value of polyline (_text p2 bearing to height (caddr p));;;;added by rrulep to label the end points of polyline (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) (setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0))) (_text point1 bearing to height (caddr point1));;;;modified by mircea to get the elevation value of polyline (setq chainage (+ chainage dist)) ) (setq count (1+ count)) ) ) Edited August 7, 2014 by SLW210 Fixed Code Tag Quote Link to comment Share on other sites More sharing options...
pBe Posted August 7, 2014 Share Posted August 7, 2014 If the length of the polyline is less than the contour interval, it does not create label. What do you want the program to do instead? terminate the program? or do something else? Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 7, 2014 Author Share Posted August 7, 2014 What do you want the program to do instead? terminate the program? or do something else? i want to label the midpoint of the polyline Quote Link to comment Share on other sites More sharing options...
pBe Posted August 7, 2014 Share Posted August 7, 2014 (edited) will that be text at start/mid/end for *LINES whose length is less than interval value? OR Start and end would be enough? Edited August 7, 2014 by pBe Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 7, 2014 Author Share Posted August 7, 2014 i want to label the midpoint of the polyline The code should be like this. If the interval is equal or greater than the length of polyline, it should label only the start point, midpoint, and endpoint of the polyline. (drawing on right side) If the interval is less than the length of the polyline, it should label the polyline like on the drawing (left side). Quote Link to comment Share on other sites More sharing options...
pBe Posted August 7, 2014 Share Posted August 7, 2014 Forgive me for coming in late for the party, but is the routine exclusively for straight segments? Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 7, 2014 Author Share Posted August 7, 2014 Forgive me for coming in late for the party, but is the routine exclusively for straight segments? no pbe i just use straight line for demonstration. Quote Link to comment Share on other sites More sharing options...
pBe Posted August 8, 2014 Share Posted August 8, 2014 Apologies for running out on you rrulep. (defun c:cl (/ _text _ang offset height to count ss ent chainage ln _mp bearing p p2 point1) (vl-load-com) (defun _text (p b o h c) ;;; modified by pbe to add background mask (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o)) ) (list (cons 40 h)) (list (cons 1 (strcat "" (if (setq ld (nth (strlen (rtos c 2 0)) '(x ""))) ld "" ) (rtos c 2 0) ) ) ) (list (cons 50 (+ b (/ pi 2)))) (list '(41 . 0) '(90 . 3) ;<-- Mask '(63 . 256) ;<--Mask '(441 . 3935927) ;<-- Mask '(71 . 5) '(72 . 5) (cons 7 (getvar "textstyle")) '(210 0.0 0.0 1.0) '(73 . 3) ) ) ) ) ;;; Modified by pBe ;;; (defun _ang (en d pt) (+ (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt) ) ) (* pi 1.5) ) ) ;;; Modified by pBe ;;; (setq dist (cond ((getdist "Contour Label Interval <100>:")) (100) ) ) (setq offset 0) (setq height 2.5) (setq to 0) (setq ss (ssget) count 0 ) (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage dist ) (setq p (vlax-curve-getstartpoint ent)) (setq p2 (vlax-curve-getendpoint ent)) ;;; Additional option / re-arrange sequence ;;; ;;;;modified by mircea to get the elevation value of polyline (_text p (_ang ent chainage p) to height (caddr p)) ;;; Start/Mid/End mode iI Length is less than or equal twice the value of dist variable ;;; (if (<= (setq ln (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent) ) ) (* 2 dist) ) (_text (setq _mp (vlax-curve-getpointatdist ent (* ln 0.5))) (_ang ent (* ln 0.5) _mp) to height (caddr _mp) ) (while (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq bearing (_ang ent (+ chainage dist) point1)) (_text point1 bearing to height (caddr point1)) (setq chainage (+ chainage dist)) ) ) (_text p2 (_ang ent chainage p2) to height (caddr p2)) (setq count (1+ count)) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted August 8, 2014 Share Posted August 8, 2014 hi hanhphucCan you check this code. Works fine with me but still need your help guys to improve it. If the length of the polyline is less than the contour interval, it does not create label. i just add a line in red, not fully tested ;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; [color="red"](setq *dist* 100.) ; default[/color] (defun c:cl (/ dist height to ss count height ent obj chainage p p2 len obj bearing); <-- localize (vl-load-com) (defun _text (p b o h c) ;;; modified by pbe to add background mask (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o))) (list (cons 40 h)) (list (cons 1 (strcat "" (if (setq ld (nth (strlen (rtos c 2 0)) '(x ""))) ld "" ) ;_ end of if (rtos c 2 0) ) ;_ end of strcat ) ;_ end of cons ) ;_ end of list (list (cons 50 (+ b (/ pi 2)))) (list '(41 . 0) '(90 . 3) ;<-- Mask '(63 . 256) ;<--Mask '(441 . 3935927) ;<-- Mask '(71 . 5) '(72 . 5) (cons 7 (getvar "textstyle")) '(210 0.0 0.0 1.0) '(73 . 3) ) ;_ end of list ) ;_ end of append ) ;_ end of entmake ) ;_ end of defun (defun _ang (p1 p2) (+ (angle p1 p2) (/ (* 3 PI) 2.0))) ;;; (setq *dist* (cond ((getdist "Contour Label Interval <100>:")) ;;; (100) ;;; ) ;_ end of cond ;;; ) ;_ end of setq [color="blue"];;modified by hanhphuc *dist* variable sets to global, just [Enter] for default[/color] [color="red"] (initget 6) ; prevent entering negative & zero (setq dist (getdist (strcat "Contour Label Interval <" (if (and *dist* (numberp *dist*)) (rtos *dist*) "100" ) ;_ end of if "> : " ) ;_ end of strcat ) ;_ end of getdist *dist* (if (not dist) *dist* dist ) ;_ end of if ) ;_ end of setq[/color] ;;; (setq offset 0) (setq height 2.5 to 0 ss (ssget) count 0 ;;; dist dist ;;; offset offset ;;; height height ) ;_ end of setq (if ss (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage *dist* ) ;_ end of setq (setq p (vlax-curve-getstartpoint obj)) (setq p2 (vlax-curve-getendpoint obj)) ;;;;added by rrulep to label the end points of polyline [color="blue"];;added by hanhphuc if interval > length, (if.. progn..)[/color] [color="red"] (setq len (vlax-curve-getDistAtPoint obj p2)) (if (>= *dist* len) (mapcar ''((x) (_text x (_ang x (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj p) 0.001))) to (* height 10. (/ (getvar 'viewsize) (cadr (getvar 'screensize)))) (caddr x) ) ) (list p (vlax-curve-getPointAtDist obj (/ len 2)) p2) ) ;_ end of mapcar[/color] [color="red"](progn [/color](setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))) (_text p bearing to height (caddr p)) ;;;;modified by mircea to get the elevation value of polyline (_text p2 bearing to height (caddr p)) ;;;;added by rrulep to label the end points of polyline (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) ;_ end of and (setq bearing (+ (angle point1 point2) (/ (* 3 PI) 2.0))) (_text point1 bearing to height (caddr point1)) ;;;;modified by mircea to get the elevation value of polyline (setq chainage (+ chainage *dist*)) ) ;_ end of while (setq count (1+ count)) [color="red"] ) ;_ end of progn ) ;_ end of if[/color] ) ;_ end of repeat ) ;_ end of if ) ;_ end of defun Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 8, 2014 Author Share Posted August 8, 2014 Apologies for running out on you rrulep. (defun c:cl (/ _text _ang offset height to count ss ent chainage ln _mp bearing p p2 point1) (vl-load-com) (defun _text (p b o h c) ;;; modified by pbe to add background mask (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o)) ) (list (cons 40 h)) (list (cons 1 (strcat "" (if (setq ld (nth (strlen (rtos c 2 0)) '(x ""))) ld "" ) (rtos c 2 0) ) ) ) (list (cons 50 (+ b (/ pi 2)))) (list '(41 . 0) '(90 . 3) ;<-- Mask '(63 . 256) ;<--Mask '(441 . 3935927) ;<-- Mask '(71 . 5) '(72 . 5) (cons 7 (getvar "textstyle")) '(210 0.0 0.0 1.0) '(73 . 3) ) ) ) ) ;;; Modified by pBe ;;; (defun _ang (en d pt) (+ (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt) ) ) (* pi 1.5) ) ) ;;; Modified by pBe ;;; (setq dist (cond ((getdist "Contour Label Interval <100>:")) (100) ) ) (setq offset 0) (setq height 2.5) (setq to 0) (setq ss (ssget) count 0 ) (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage dist ) (setq p (vlax-curve-getstartpoint ent)) (setq p2 (vlax-curve-getendpoint ent)) ;;; Additional option / re-arrange sequence ;;; ;;;;modified by mircea to get the elevation value of polyline (_text p (_ang ent chainage p) to height (caddr p)) ;;; Start/Mid/End mode iI Length is less than or equal twice the value of dist variable ;;; (if (<= (setq ln (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent) ) ) (* 2 dist) ) (_text (setq _mp (vlax-curve-getpointatdist ent (* ln 0.5))) (_ang ent (* ln 0.5) _mp) to height (caddr _mp) ) (while (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq bearing (_ang ent (+ chainage dist) point1)) (_text point1 bearing to height (caddr point1)) (setq chainage (+ chainage dist)) ) ) (_text p2 (_ang ent chainage p2) to height (caddr p2)) (setq count (1+ count)) ) (princ) ) Thanks pbe It works perfectly:D waiting for your reply is worthit Quote Link to comment Share on other sites More sharing options...
rrulep Posted August 8, 2014 Author Share Posted August 8, 2014 i just add a line in red, not fully tested ;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; [color="red"](setq *dist* 100.) ; default[/color] (defun c:cl (/ dist height to ss count height ent obj chainage p p2 len obj bearing); <-- localize (vl-load-com) (defun _text (p b o h c) ;;; modified by pbe to add background mask (entmake (append '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "C-CTRL_TXT") (100 . "AcDbMText") ) (list (cons 10 (polar p (+ b PI) o))) (list (cons 40 h)) (list (cons 1 (strcat "" (if (setq ld (nth (strlen (rtos c 2 0)) '(x ""))) ld "" ) ;_ end of if (rtos c 2 0) ) ;_ end of strcat ) ;_ end of cons ) ;_ end of list (list (cons 50 (+ b (/ pi 2)))) (list '(41 . 0) '(90 . 3) ;<-- Mask '(63 . 256) ;<--Mask '(441 . 3935927) ;<-- Mask '(71 . 5) '(72 . 5) (cons 7 (getvar "textstyle")) '(210 0.0 0.0 1.0) '(73 . 3) ) ;_ end of list ) ;_ end of append ) ;_ end of entmake ) ;_ end of defun (defun _ang (p1 p2) (+ (angle p1 p2) (/ (* 3 PI) 2.0))) ;;; (setq *dist* (cond ((getdist "Contour Label Interval <100>:")) ;;; (100) ;;; ) ;_ end of cond ;;; ) ;_ end of setq [color="blue"];;modified by hanhphuc *dist* variable sets to global, just [Enter] for default[/color] [color="red"] (initget 6) ; prevent entering negative & zero (setq dist (getdist (strcat "Contour Label Interval <" (if (and *dist* (numberp *dist*)) (rtos *dist*) "100" ) ;_ end of if "> : " ) ;_ end of strcat ) ;_ end of getdist *dist* (if (not dist) *dist* dist ) ;_ end of if ) ;_ end of setq[/color] ;;; (setq offset 0) (setq height 2.5 to 0 ss (ssget) count 0 ;;; dist dist ;;; offset offset ;;; height height ) ;_ end of setq (if ss (repeat (sslength ss) (setq ent (ssname ss count) obj (vlax-ename->vla-object ent) chainage *dist* ) ;_ end of setq (setq p (vlax-curve-getstartpoint obj)) (setq p2 (vlax-curve-getendpoint obj)) ;;;;added by rrulep to label the end points of polyline [color="blue"];;added by hanhphuc if interval > length, (if.. progn..)[/color] [color="red"] (setq len (vlax-curve-getDistAtPoint obj p2)) (if (>= *dist* len) (mapcar ''((x) (_text x (_ang x (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj p) 0.001))) to (* height 10. (/ (getvar 'viewsize) (cadr (getvar 'screensize)))) (caddr x) ) ) (list p (vlax-curve-getPointAtDist obj (/ len 2)) p2) ) ;_ end of mapcar[/color] [color="red"](progn [/color](setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))) (_text p bearing to height (caddr p)) ;;;;modified by mircea to get the elevation value of polyline (_text p2 bearing to height (caddr p)) ;;;;added by rrulep to label the end points of polyline (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage)) (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001))) ) ;_ end of and (setq bearing (+ (angle point1 point2) (/ (* 3 PI) 2.0))) (_text point1 bearing to height (caddr point1)) ;;;;modified by mircea to get the elevation value of polyline (setq chainage (+ chainage *dist*)) ) ;_ end of while (setq count (1+ count)) [color="red"] ) ;_ end of progn ) ;_ end of if[/color] ) ;_ end of repeat ) ;_ end of if ) ;_ end of defun hi hanhphuc it also works thanks for your help guys Quote Link to comment Share on other sites More sharing options...
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.