oliver Posted June 19, 2010 Share Posted June 19, 2010 Generate Bearings & Distances into table as shown in figure.. please help us thank you. Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 19, 2010 Share Posted June 19, 2010 You can do this is Land Desktop and Civil 3D. Quote Link to comment Share on other sites More sharing options...
fixo Posted June 19, 2010 Share Posted June 19, 2010 Generate Bearings & Distances into tableas shown in figure.. please help us thank you. Try this one (quick and dirty though) (vl-load-com) (defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm point_list pt row table_data tmp tmp_data) (defun *error* (msg) (if (and msg (not (member msg '("console break" "Function cancelled" "quit / exit abort")))) (princ (strcat "\nError: " msg)) ) (if osm (setvar "osmode" osm)) (princ) ) (setq osm (getvar "osmode")) (setvar "osmode" 1) (setq cnt 1) (while (setq pt (getpoint (strcat "\n >> Specify point #" (itoa cnt) " by order (hit Enter to exit) >> "))) (setq point_list (cons pt point_list) cnt (1+ cnt)) ) (setq point_list (reverse point_list)) (setq cnt 0) (while (<= cnt (- (length point_list) 2)) (setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2))) (nth cnt point_list) (nth (1+ cnt) point_list)) tmp_data (cons tmp tmp_data) ) (setq cnt (1+ cnt)) ) (setq tmp (list (strcat (itoa (length point_list)) " - 1") (last point_list) (car point_list)) tmp_data (cons tmp tmp_data) ) (setq tmp_data (reverse tmp_data)) (foreach item tmp_data (setq ang (angle (cadr item) (caddr item))) (setq ang (angtos ang 4 4)) (setq dist (distance (cadr item) (caddr item))) (setq dist (strcat (rtos dist 2 2) " m.")) (setq tmp (list (car item) ang dist)) (setq table_data (cons tmp table_data)) ) (setq table_data (reverse table_data)) (setq pt (getpoint "\n >> Specify insertion point >> ")) (setq acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) ) (setq atable (vlax-invoke acsp 'AddTable pt (+ 2 (length table_data)) (length (car table_data)) (* (getvar "textsize") 2.0) (* (getvar "textsize") 15)) ) (vla-put-regeneratetablesuppressed atable :vlax-true) (vla-settextheight atable actitlerow (getvar "textsize")) (vla-settextheight atable acheaderrow (getvar "textsize")) (vla-settextheight atable acdatarow (getvar "textsize")) (vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25)) (vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS") (vla-settext atable 1 0 "LINES") (vla-settext atable 1 1 "BEARINGS") (vla-settext atable 1 2 "DISTANCES") (setq row 2) (foreach item table_data (setq col 0) (foreach x item (vla-settext atable row col x) (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)) ) (vla-put-regeneratetablesuppressed atable :vlax-false) (*error* nil) (princ) ) ~'J'~ Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 19, 2010 Share Posted June 19, 2010 Try this one (quick and dirty though) (vl-load-com) (defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm point_list pt row table_data tmp tmp_data) (defun *error* (msg) (if (and msg (not (member msg '("console break" "Function cancelled" "quit / exit abort")))) (princ (strcat "\nError: " msg)) ) (if osm (setvar "osmode" osm)) (princ) ) (setq osm (getvar "osmode")) (setvar "osmode" 1) (setq cnt 1) (while (setq pt (getpoint (strcat "\n >> Specify point #" (itoa cnt) " by order (hit Enter to exit) >> "))) (setq point_list (cons pt point_list) cnt (1+ cnt)) ) (setq point_list (reverse point_list)) (setq cnt 0) (while (<= cnt (- (length point_list) 2)) (setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2))) (nth cnt point_list) (nth (1+ cnt) point_list)) tmp_data (cons tmp tmp_data) ) (setq cnt (1+ cnt)) ) (setq tmp (list (strcat (itoa (length point_list)) " - 1") (last point_list) (car point_list)) tmp_data (cons tmp tmp_data) ) (setq tmp_data (reverse tmp_data)) (foreach item tmp_data (setq ang (angle (cadr item) (caddr item))) (setq ang (angtos ang 4 4)) (setq dist (distance (cadr item) (caddr item))) (setq dist (strcat (rtos dist 2 2) " m.")) (setq tmp (list (car item) ang dist)) (setq table_data (cons tmp table_data)) ) (setq table_data (reverse table_data)) (setq pt (getpoint "\n >> Specify insertion point >> ")) (setq acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) ) (setq atable (vlax-invoke acsp 'AddTable pt (+ 2 (length table_data)) (length (car table_data)) (* (getvar "textsize") 2.0) (* (getvar "textsize") 15)) ) (vla-put-regeneratetablesuppressed atable :vlax-true) (vla-settextheight atable actitlerow (getvar "textsize")) (vla-settextheight atable acheaderrow (getvar "textsize")) (vla-settextheight atable acdatarow (getvar "textsize")) (vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25)) (vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS") (vla-settext atable 1 0 "LINES") (vla-settext atable 1 1 "BEARINGS") (vla-settext atable 1 2 "DISTANCES") (setq row 2) (foreach item table_data (setq col 0) (foreach x item (vla-settext atable row col x) (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)) ) (vla-put-regeneratetablesuppressed atable :vlax-false) (*error* nil) (princ) ) ~'J'~ This is great !!! why does Acad insist on putting the "d" in the bearing angle instead of chr alt 248 (degree symbol) ? Is there a way to program the degree symbol ? into the bearing instead of "d" ? If not, one can always edit the table line by line... Thanks for super program for those who do not have civil add on. S Quote Link to comment Share on other sites More sharing options...
Small Fish Posted June 19, 2010 Share Posted June 19, 2010 Substitute (setq ang (angtos ang 4 4)) for (setq ang (vl-string-subst "°" "d" (angtos ang 4 4))) will give you the degrees symbol SF Quote Link to comment Share on other sites More sharing options...
fixo Posted June 19, 2010 Share Posted June 19, 2010 Substitute (setq ang (angtos ang 4 4)) for (setq ang (vl-string-subst "°" "d" (angtos ang 4 4))) will give you the degrees symbol SF Thanks, it's much easier that I've thought ~'J'~ Quote Link to comment Share on other sites More sharing options...
Small Fish Posted June 19, 2010 Share Posted June 19, 2010 I have modified it some more, so that the end result is easier to read. If minutes and/or seconds are under 10 then a zero has been added to the bearing string. hope that's useful SF (vl-load-com) (defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm point_list pt row table_data tmp tmp_data degreeloc minuteloc secondloc AngString) (defun *error* (msg) (if (and msg (not (member msg '("console break" "Function cancelled" "quit / exit abort")))) (princ (strcat "\nError: " msg)) ) (if osm (setvar "osmode" osm)) (princ) ) (setq osm (getvar "osmode")) (setvar "osmode" 1) (setq cnt 1) (while (setq pt (getpoint (strcat "\n >> Specify point #" (itoa cnt) " by order (hit Enter to exit) >> "))) (setq point_list (cons pt point_list) cnt (1+ cnt)) ) (setq point_list (reverse point_list)) (setq cnt 0) (while (<= cnt (- (length point_list) 2)) (setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2))) (nth cnt point_list) (nth (1+ cnt) point_list)) tmp_data (cons tmp tmp_data) ) (setq cnt (1+ cnt)) ) (setq tmp (list (strcat (itoa (length point_list)) " - 1") (last point_list) (car point_list)) tmp_data (cons tmp tmp_data) ) (setq tmp_data (reverse tmp_data)) (foreach item tmp_data (setq ang (angtos(angle (cadr item) (caddr item))4 4) degreeloc (vl-string-position (ascii "d") ang);location of "d" minuteloc (vl-string-position (ascii "'") ang);location of ' secondloc (vl-string-position (ascii "\"") ang);location of " );setq (if (= (- minuteloc degreeloc) 2) (setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10 );if (if (= (- secondloc minuteloc) 2) (setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10 );if (setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol dist (distance (cadr item) (caddr item)) dist (strcat (rtos dist 2 2) " m.") tmp (list (car item) AngString dist) table_data (cons tmp table_data) );setq );foreach (setq table_data (reverse table_data) pt (getpoint "\n >> Specify insertion point >> ") acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) atable (vlax-invoke acsp 'AddTable pt (+ 2 (length table_data)) (length (car table_data)) (* (getvar "textsize") 2.0) (* (getvar "textsize") 15)) );setq (vla-put-regeneratetablesuppressed atable :vlax-true) (vla-settextheight atable actitlerow (getvar "textsize")) (vla-settextheight atable acheaderrow (getvar "textsize")) (vla-settextheight atable acdatarow (getvar "textsize")) (vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25)) (vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS") (vla-settext atable 1 0 "LINES") (vla-settext atable 1 1 "BEARINGS") (vla-settext atable 1 2 "DISTANCES") (setq row 2) (foreach item table_data (setq col 0) (foreach x item (vla-settext atable row col x) (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)) ) (vla-put-regeneratetablesuppressed atable :vlax-false) (*error* nil) (princ) ) Quote Link to comment Share on other sites More sharing options...
oliver Posted June 20, 2010 Author Share Posted June 20, 2010 I have modified it some more, so that the end result is easier to read.If minutes and/or seconds are under 10 then a zero has been added to the bearing string. hope that's useful SF (vl-load-com) (defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm point_list pt row table_data tmp tmp_data degreeloc minuteloc secondloc AngString) (defun *error* (msg) (if (and msg (not (member msg '("console break" "Function cancelled" "quit / exit abort")))) (princ (strcat "\nError: " msg)) ) (if osm (setvar "osmode" osm)) (princ) ) (setq osm (getvar "osmode")) (setvar "osmode" 1) (setq cnt 1) (while (setq pt (getpoint (strcat "\n >> Specify point #" (itoa cnt) " by order (hit Enter to exit) >> "))) (setq point_list (cons pt point_list) cnt (1+ cnt)) ) (setq point_list (reverse point_list)) (setq cnt 0) (while (<= cnt (- (length point_list) 2)) (setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2))) (nth cnt point_list) (nth (1+ cnt) point_list)) tmp_data (cons tmp tmp_data) ) (setq cnt (1+ cnt)) ) (setq tmp (list (strcat (itoa (length point_list)) " - 1") (last point_list) (car point_list)) tmp_data (cons tmp tmp_data) ) (setq tmp_data (reverse tmp_data)) (foreach item tmp_data (setq ang (angtos(angle (cadr item) (caddr item))4 4) degreeloc (vl-string-position (ascii "d") ang);location of "d" minuteloc (vl-string-position (ascii "'") ang);location of ' secondloc (vl-string-position (ascii "\"") ang);location of " );setq (if (= (- minuteloc degreeloc) 2) (setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10 );if (if (= (- secondloc minuteloc) 2) (setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10 );if (setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol dist (distance (cadr item) (caddr item)) dist (strcat (rtos dist 2 2) " m.") tmp (list (car item) AngString dist) table_data (cons tmp table_data) );setq );foreach (setq table_data (reverse table_data) pt (getpoint "\n >> Specify insertion point >> ") acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) atable (vlax-invoke acsp 'AddTable pt (+ 2 (length table_data)) (length (car table_data)) (* (getvar "textsize") 2.0) (* (getvar "textsize") 15)) );setq (vla-put-regeneratetablesuppressed atable :vlax-true) (vla-settextheight atable actitlerow (getvar "textsize")) (vla-settextheight atable acheaderrow (getvar "textsize")) (vla-settextheight atable acdatarow (getvar "textsize")) (vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25)) (vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS") (vla-settext atable 1 0 "LINES") (vla-settext atable 1 1 "BEARINGS") (vla-settext atable 1 2 "DISTANCES") (setq row 2) (foreach item table_data (setq col 0) (foreach x item (vla-settext atable row col x) (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)) ) (vla-put-regeneratetablesuppressed atable :vlax-false) (*error* nil) (princ) ) thank you so much.. Quote Link to comment Share on other sites More sharing options...
Small Fish Posted June 20, 2010 Share Posted June 20, 2010 Glad to help out Quote Link to comment Share on other sites More sharing options...
oliver Posted June 20, 2010 Author Share Posted June 20, 2010 I have modified it some more, so that the end result is easier to read.If minutes and/or seconds are under 10 then a zero has been added to the bearing string. hope that's useful SF (vl-load-com) (defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm point_list pt row table_data tmp tmp_data degreeloc minuteloc secondloc AngString) (defun *error* (msg) (if (and msg (not (member msg '("console break" "Function cancelled" "quit / exit abort")))) (princ (strcat "\nError: " msg)) ) (if osm (setvar "osmode" osm)) (princ) ) (setq osm (getvar "osmode")) (setvar "osmode" 1) (setq cnt 1) (while (setq pt (getpoint (strcat "\n >> Specify point #" (itoa cnt) " by order (hit Enter to exit) >> "))) (setq point_list (cons pt point_list) cnt (1+ cnt)) ) (setq point_list (reverse point_list)) (setq cnt 0) (while (<= cnt (- (length point_list) 2)) (setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2))) (nth cnt point_list) (nth (1+ cnt) point_list)) tmp_data (cons tmp tmp_data) ) (setq cnt (1+ cnt)) ) (setq tmp (list (strcat (itoa (length point_list)) " - 1") (last point_list) (car point_list)) tmp_data (cons tmp tmp_data) ) (setq tmp_data (reverse tmp_data)) (foreach item tmp_data (setq ang (angtos(angle (cadr item) (caddr item))4 4) degreeloc (vl-string-position (ascii "d") ang);location of "d" minuteloc (vl-string-position (ascii "'") ang);location of ' secondloc (vl-string-position (ascii "\"") ang);location of " );setq (if (= (- minuteloc degreeloc) 2) (setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10 );if (if (= (- secondloc minuteloc) 2) (setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10 );if (setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol dist (distance (cadr item) (caddr item)) dist (strcat (rtos dist 2 2) " m.") tmp (list (car item) AngString dist) table_data (cons tmp table_data) );setq );foreach (setq table_data (reverse table_data) pt (getpoint "\n >> Specify insertion point >> ") acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) atable (vlax-invoke acsp 'AddTable pt (+ 2 (length table_data)) (length (car table_data)) (* (getvar "textsize") 2.0) (* (getvar "textsize") 15)) );setq (vla-put-regeneratetablesuppressed atable :vlax-true) (vla-settextheight atable actitlerow (getvar "textsize")) (vla-settextheight atable acheaderrow (getvar "textsize")) (vla-settextheight atable acdatarow (getvar "textsize")) (vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25)) (vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS") (vla-settext atable 1 0 "LINES") (vla-settext atable 1 1 "BEARINGS") (vla-settext atable 1 2 "DISTANCES") (setq row 2) (foreach item table_data (setq col 0) (foreach x item (vla-settext atable row col x) (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)) ) (vla-put-regeneratetablesuppressed atable :vlax-false) (*error* nil) (princ) ) once again thank you..another little favor could you please modified this lisp.."remove the seconds" as shown in the figure in my first post. thanks and "HAPPY FATHER'S DAY" Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 20, 2010 Share Posted June 20, 2010 I'll say it once more then keep my mouth shut: You can do this very thing from core LDD and/or C3D and it's a lot easier. Quote Link to comment Share on other sites More sharing options...
Small Fish Posted June 20, 2010 Share Posted June 20, 2010 Try this - without seconds check out angtos function you can adjust the the two numbers at the end of this line for a different format. (setq ang (angtos(angle (cadr item) (caddr item))4 2);precision 2 - ;minutes only updated code- (vl-load-com) (defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm point_list pt row table_data tmp tmp_data degreeloc minuteloc secondloc AngString) (defun *error* (msg) (if (and msg (not (member msg '("console break" "Function cancelled" "quit / exit abort")))) (princ (strcat "\nError: " msg)) ) (if osm (setvar "osmode" osm)) (princ) ) (setq osm (getvar "osmode")) (setvar "osmode" 1) (setq cnt 1) (while (setq pt (getpoint (strcat "\n >> Specify point #" (itoa cnt) " by order (hit Enter to exit) >> "))) (setq point_list (cons pt point_list) cnt (1+ cnt)) ) (setq point_list (reverse point_list)) (setq cnt 0) (while (<= cnt (- (length point_list) 2)) (setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2))) (nth cnt point_list) (nth (1+ cnt) point_list)) tmp_data (cons tmp tmp_data) ) (setq cnt (1+ cnt)) ) (setq tmp (list (strcat (itoa (length point_list)) " - 1") (last point_list) (car point_list)) tmp_data (cons tmp tmp_data) ) (setq tmp_data (reverse tmp_data)) (foreach item tmp_data (setq ang (angtos(angle (cadr item) (caddr item))4 2);precision 2 - minutes only degreeloc (vl-string-position (ascii "d") ang);location of "d" minuteloc (vl-string-position (ascii "'") ang);location of ' ;;; secondloc (vl-string-position (ascii "\"") ang);location of " );setq (if (= (- minuteloc degreeloc) 2) (setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10 );if ;;; (if (= (- secondloc minuteloc) 2) ;;; (setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10 ;;; );if (setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol dist (distance (cadr item) (caddr item)) dist (strcat (rtos dist 2 2) " m.") tmp (list (car item) AngString dist) table_data (cons tmp table_data) );setq );foreach (setq table_data (reverse table_data) pt (getpoint "\n >> Specify insertion point >> ") acsp (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) atable (vlax-invoke acsp 'AddTable pt (+ 2 (length table_data)) (length (car table_data)) (* (getvar "textsize") 2.0) (* (getvar "textsize") 15)) );setq (vla-put-regeneratetablesuppressed atable :vlax-true) (vla-settextheight atable actitlerow (getvar "textsize")) (vla-settextheight atable acheaderrow (getvar "textsize")) (vla-settextheight atable acdatarow (getvar "textsize")) (vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25)) (vla-settext atable 0 0 "TECHNICAL DESCRIPTIONS") (vla-settext atable 1 0 "LINES") (vla-settext atable 1 1 "BEARINGS") (vla-settext atable 1 2 "DISTANCES") (setq row 2) (foreach item table_data (setq col 0) (foreach x item (vla-settext atable row col x) (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)) ) (vla-put-regeneratetablesuppressed atable :vlax-false) (*error* nil) (princ) ) Quote Link to comment Share on other sites More sharing options...
Small Fish Posted June 20, 2010 Share Posted June 20, 2010 I'll say it once more then keep my mouth shut: You can do this very thing from core LDD and/or C3D and it's a lot easier. But Alan not all of us have LDD and/or C3D. Most of us just have plain vanilla Autocad Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 20, 2010 Share Posted June 20, 2010 Does LDD/C3D cost a lot more than Vanilla CAD? Just curious Quote Link to comment Share on other sites More sharing options...
oliver Posted June 20, 2010 Author Share Posted June 20, 2010 thanks to all. Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 20, 2010 Share Posted June 20, 2010 But Alan not all of us have LDD and/or C3D. Most of us just have plain vanilla Autocad True, but the OP (oliver) has LDD. Does LDD/C3D cost a lot more than Vanilla CAD? Just curious Much much more. All the addon version of cad are a lot more expensive. I think C3D is around $6000. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 20, 2010 Share Posted June 20, 2010 Much much more. All the addon version of cad are a lot more expensive. I think C3D is around $6000. Woww... I never realised that! Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 20, 2010 Share Posted June 20, 2010 Woww... I never realised that! I think vanilla is around $3000. They're all AutoCAD, just with lots of extras. Quote Link to comment Share on other sites More sharing options...
The Buzzard Posted June 21, 2010 Share Posted June 21, 2010 I think vanilla is around $3000.They're all AutoCAD, just with lots of extras. Your close, More like $3,995 US dollars just for vanilla. Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 21, 2010 Share Posted June 21, 2010 Your close, More like $3,995 US dollars just for vanilla. Ahh, OK. The last time I worked anywhere that used Vanilla AutoCAD, I was 18 and it was r2000. 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.