Guest Posted June 18, 2013 Posted June 18, 2013 (edited) can anyone convert this lisp !!! a) To ask (prompt "\n please Select Line : ") ,give the text size ..... b) to write bearing (in grads) add the distanse like the attach photo (defun C:BD() (princ "Bearing and distance between 2 points ") (copyright) (setq pnt (getpoint "\n1ο point {(X,Y,Z) or mouse}: ")) (setq pnt1(getpoint "\n2ο point {(X,Y,Z) or mouse}:")) (terpri) (setq sdis (rtos (distance pnt pnt1) 2 3)) (setq ang1 (angle pnt pnt1)) (setq ang (angtos ang1 2 4)) (setq dx (-(car pnt1)(car pnt))) (setq dy (-(cadr pnt1)(cadr pnt))) (setq dz (-(caddr pnt1)(caddr pnt))) (setq pn (list (car pnt) (cadr pnt) 0) ) (setq pn1 (list (car pnt1) (cadr pnt1) 0)) (setq dis (rtos (distance pn pn1) 2 3)) (textscr) (princ "\n") (princ "\n Bearing and distance between 2 points P1 P2 ") (princ "\n") (princ "\n P1 X: ")(princ (car pnt)) (princ " Y: ")(princ (cadr pnt)) (princ" Z: ")(princ (caddr pnt)) (princ "\n P2 X: ")(princ (car pnt1)) (princ " Y: ")(princ (cadr pnt1)) (princ " Z: ")(princ (caddr pnt1)) (princ "\n slope distanse: ")(princ sdis) (princ " distanse.:") (princ dis) (princ "\n bearing: ")(princ ang) (princ"\n Dx: ")(princ dx)(princ " Dy: ")(princ dy) (princ " Dz: ")(princ dz) (princ) ) Edited June 18, 2013 by prodromosm Quote
Guest Posted June 18, 2013 Posted June 18, 2013 any ideas ?????????? I need this ... please help Quote
Tharwat Posted June 18, 2013 Posted June 18, 2013 You need to describe what you want to do in more details Quote
Guest Posted June 18, 2013 Posted June 18, 2013 I need this lisp to write the bearing angle (in grads) and the distanse of a line (like the photo).And if you can .... to select a line or polyline and write them (not to pick points) I have and this lisp but writes only the distance between points can any one join this 2 lisp to make the lisp i want ? please ;qq.lsp ; ;****************************************************** (Defun C:qq (/ txtstl txtsze stryn prfx sufx svr scl ht pt pti ptx pty old oldpl nodpl ptyp pllst i n prin meta distmeta ptdist angprin angmeta angtxt ptp alfa nlin xlin ylin dlin flg xreg yreg na xa ya) ;*************drawing set-up*************************** ; (command "undo" "m") (setvar "unitmode" 0) (setvar "aunits" 2) (setvar "angbase" (/ pi 2)) (setvar "angdir" 1) (setvar "auprec" 4) (setvar "lunits" 2) (setvar "luprec" 3) (setvar "dimzin" 0) (setq svr(getvar "osmode")) (setq txtstl(getvar "textstyle")) (setq txtsze(getvar "textsize")) (setvar "cmdecho" 0) (setq flg 1) (setvar "cmdecho" 0) (command "layer" "m" "diast" "") (setq scl(/ (getreal "\n select scale (100,200,500,etc) : ") 100)) (setq ht(* 0.175 scl)) :********BOUNDARY LINE********** (setvar "osmode" 0) (setq old(entsel "\n select lwpolyline: ")) (setq oldpl(entget(car old))) (setq nodpl(cdr(assoc 90 oldpl))) (setq ptyp (cdr(assoc 70 oldpl))) (command "area" "e" old) (setq pllst '()) (setq i 0) (setq n 0) (while (car(nth i oldpl)) (if (= (car(nth i oldpl)) 10) (progn (setq pllst (append pllst (list (cdr(nth i oldpl))))) (setq n(+ 1 n)) );endprogn );endif (setq i (+ i 1)) );endwhile (if (= ptyp 1) (progn (setq pllst (append pllst (list(nth 0 pllst)))) (setq pllst (cdr pllst)) );endprogn );endif ; (main) ;close defun ;(defun main() ;*******CIRCLES ON LANDMARKS*********** (command "style" "diast" "wgsimpl.shx" "" "" "" "" "") (setq alfa 193) (command "circle" pt (/ ht 5)) (command "copy" pt "" "m" pt) (foreach n pllst (command n)) (command "") (command "erase" pt "") (setq i 0 prin 0 meta 0) (while (car(nth i pllst)) (setq prin (- i 1)) (setq meta (+ i 1)) (if (= i 0) (setq prin (- n 1)) ) (if (= i (- n 1)) (setq meta 0) ) (setq angprin (angle (nth i pllst) (nth prin pllst))) (setq angmeta (angle (nth i pllst) (nth meta pllst))) (setq distmeta (distance (nth i pllst) (nth meta pllst))) ;**************DISTANCES BETWEEN LANDMARKS********************** (setq ptdist (polar (polar (nth i pllst) angmeta (/ distmeta 2)) (+ angmeta (* (/ pi 2) flg)) (* 0.25 ht))) (setq angtxt(- 500 (/ (* 400 angmeta) (* 2 pi)))) (if (> angtxt 400) (setq angtxt (- angtxt 400)) ) (if (> angtxt 200) (progn (setq ptdist (polar (polar (nth i pllst) angmeta (/ distmeta 2)) (+ angmeta (* (/ pi 2) flg)) (* 1.25 ht))) (setq angtxt (- angtxt 200)) );endprogn ) (command "text" "j" "c" ptdist ht angtxt (rtos distmeta 2 2) ) (setq i (+ i 1)) );endwhile (if (= ptyp 0) (command "erase" "l" "") ) ;********** ; (initget "Yes No") ; (setq stryn(getkword "\nSatisfied? (Yes or No) :")) ; (if (= stryn "Yes") ; (ok) ; );end if ; (if (= stryn "No") ; (progn ; (command "undo" "b") ; (command "undo" "m") ; (setq flg(* -1 flg)) ; (main) ; ) ; );end if ; (ok) ;close defun ;(defun ok () ;*********END*********************************** (setvar "osmode" svr) (setvar "cmdecho" 1) (setvar "textstyle" txtstl) (setvar "textsize" txtsze) (princ) );close defun Quote
alanjt Posted June 18, 2013 Posted June 18, 2013 1. select line 2. extract xyz for start and end points. 3. use angtos and angle to retrieve your angle. 4. use distance to retrieve your distance. 5. place the text and the midpoint between the two points. Quote
Guest Posted June 18, 2013 Posted June 18, 2013 yes something like this ... look the attach photo and you understand what i want Quote
Guest Posted June 18, 2013 Posted June 18, 2013 1. select a line or polyline 2.write the bearing (azimuth angle, in grads) on the top of the line or polyline 3. write under the line the length in meters please help .... see the attach photo in the first post Quote
Guest Posted June 18, 2013 Posted June 18, 2013 I need one lisp like this but the angle i need to be in grads. Please Help Can anyone convert this lisp for me ........ ;------------------------------------------------------------------------------ ; CAD Concepts Limited ; ; BEARING DISTANCE TEXT ; ; Copyright (C) 2011 CAD Concepts Limited. ; BEARING DISTANCE TEXT by CAD Concepts Ltd is licensed under ; a Creative Commons Attribution-ShareAlike 3.0 Unported License. ; http://creativecommons.org/licenses/by-sa/3.0/nz/deed.en ; For options available to you under this license. ; This software is provided "as is". No liability is taken of ; FITNESS FOR ANY PARTICULAR PURPOSE. ;------------------------------------------------------------------------------ ; File : BD.lsp ; Author : Jason Bourhill ; Email : jason@cadconcepts.co.nz ; Web : http://www.cadconcepts.co.nz ; Date : 20/Mar/2011 ; CAD Ver(s) : Tested on AutoCAD 2010 & Bricscad V11 ; Purpose : Places Bearing & Distance text above and below selected lines ; ; Usage : To load type (load "BD.LSP") from the command line or drag ; and drop the file onto your drawing using explorer. Will ; automatically run on loading. ; ; Select a LINES or LIGHT WEIGHT POLYLINES on your drawing. Text ; placed above the line will give the Bearing. Text placed ; below the line gives the distance. ; ; If you use inside a viewport from paperspace the routine will ; automatically work out the scale factor. If you use in model ; space you will be prompted for a scale factor. ; ; Bearing given is always between 0 - 180 deg irrespective of ; the direction the line has been drawn in. ; ; Text is placed on the current layer using the default text ; style. Text height is based on the text height for the ; current dimension style. ; ; To run the routine again type BD at the command line. ; ; NOTE in AutoCAD bearing gives a D instead of the degree symbol ; in Bricscad you get the degree symbol. ; ; Requires : Nothing else ;------------------------------------------------------------------------------ ; Rev no : A ; Reason : First release ; Rev Date : 20/Mar/2011 ; Rev by : Jason Bourhill ; Email : jason@cadconcepts.co.nz ; ; Description: ; First release. ;------------------------------------------------------------------------------ (defun C:BD ( / ASK GETDWGSCALE TEXTPOSITION LISTPLINEVER PLACETEXT sset num scalefac ent startpt endpt VerLst Ctr lstlen) ;ASK ;This routine allows default prompt issuing (defun ASK (typ prmpt def / val vt) (setq vt (type def)) (cond ((null vt) (princ (strcat prmpt ": "))) ((= vt 'STR) (princ (strcat prmpt " <" def ">: "))) ((= typ 'ANG) (princ (strcat prmpt " <" (rtd def) ">: "))) ((= vt 'REAL) (princ (strcat prmpt " <" (rtos def 2 2) ">: "))) ((= vt 'INT) (princ (strcat prmpt " <" (itoa def) ">: "))) ) (cond ((= typ 'R) (setq val (getreal))) ((= typ 'S) (setq val (getkword))) ((= typ 'ANG) (setq val (getangle))) ((= typ 'DIST) (setq val (getdist))) ((= typ 'INT) (setq val (getint))) ((= typ 'STR) (setq val (getstring))) ((= typ 'STRT)(setq val (getstring T))) ) (if (or (= val "")(= val ())) def val) ) ; find Drawing scale ; if user is inside a paperspace vport will work out dwgscale automatically ; if in paperspace set dwgscale = 1 ; if in modelspace as user for dwgscale value ; Required as Bricscad doesn't support annotative text scaling (defun getdwgscale ( ) (cond ((and (= 0 (getvar "TILEMODE")) (= 1 (getvar "CVPORT"))) ; in paperspace not inside a vport (setq dwgscale 1) ) ((and (= 0 (getvar "TILEMODE")) (> (getvar "CVPORT") 1)) ; in paperspace and inside a vport (setq dwgscale (/ 1.0 (caddr (trans '(0 0 1) 2 3)))) ) ((= 1 (getvar "TILEMODE")) ; in modelspace, ask user for dwgscale (if (not dwgscale) (setq dwgscale 0.5)) ; if not set, set dwgscale to 1:2000 assumes modelspace is in metres, and paperspace is mm (setq dwgscale (ask 'R "Drawing scale factor 0.5 = 1:2000, 1 = 1:1000, 2 = 1:500" dwgscale)) ) ) dwgscale ; return dwgscale value ) ; end getdwgscale ; Find and return the Text postion and angle value ; adjusts position and angle based on which quadrant the angle falls in ; Note internally Lisp uses radians, with 0 at East position and measures anticlockwise. (defun textposition (LineMpt Langle TextOff / TestPos Langle) (cond ((and (>= Langle 0 )(<= Langle (/ pi 2.0))) ; Langle between 0 - 90 degrees (setq TextPos (polar LineMpt (+ Langle (/ pi 2.0)) TextOff)) (setq Langle Langle) ) ((and (> Langle (/ pi 2.0))(<= Langle pi)) ; Langle between 90 - 180 degrees (setq TextPos (polar LineMpt (- Langle (/ pi 2.0)) TextOff)) (setq Langle (- Langle pi)) ) ((and (> Langle pi)(<= Langle (* pi 1.5))) ; Langle between 180 - 270 degrees (setq TextPos (polar LineMpt (- Langle (/ pi 2.0)) TextOff)) (setq Langle (- Langle pi)) ) ((and (> Langle (* pi 1.5))(<= Langle (* pi 2.0))) ; Langle between 270 - 360 degrees (setq TextPos (polar LineMpt (+ Langle (/ pi 2.0)) TextOff)) (setq Langle Langle) ) ) (list Textpos Langle) ; return the text position and angle as a list ) ; end textpostion ; List LWpline Vertices ; Iterates through presented list retaining only Lwpline vertices ; returns the vertices found as a list. (defun ListPlineVer (ent) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) ent)) ) ;end ListPlineVer (defun PlaceText (startpt endpt dwgscale / Bunits Bprec Dunits Dprec dwgscale txtoff) ; Set BEARING display preferences ; Bunit Options are: ; 0 Degrees, 1 Degrees/minutes/seconds, 2 Grads, 3 Radians, 4 Surveyor's units (setq Bunits 1) ; Degrees/minutes/seconds (setq Bprec 4) ; Angle Precision, specifies the number of decimal places ; Set DISTANCE display preferences ; Dunit Options are: ; 1 Scientific, 2 Decimal, 3 Engineering (feet and decimal inches), ; 4 Architectural (feet and fractional inches), 5 Fractional (setq Dunits 2) ; Decimal (setq Dprec 2) ; Linear Precision, specifies the number of decimal places ; Set TEXT display options ; Text OFFSET. Distance that the text is offset from the line (setq txtoff (* 1.0 dwgscale)) ;(setq txtoff (* (getvar dimgap) dwgscale)) could use dimgap if it is set to a reasonable value ; Text HEIGHT. (setq txtheight (* (getvar "DIMTXT") dwgscale)) ; use dimension text height (setq ang (angle startpt endpt) ; find angle between two points dis (distance startpt endpt) ; find distance between two points midpt (polar startpt ang (/ dis 2.0)) ; find the midpoint between the two ponts angtxtval (textposition midpt ang txtoff) ; Find Bearing Text Position and Angle angtxtpos (car angtxtval) ; Bearing text position angtxt (angtos (cadr angtxtval) Bunits Bprec) ; returns angle as a text string distxtpos (car (textposition midpt ang (* -1.0 (+ txtoff txtheight)))) ; Find Distance Text position below line, taking text height into account distxt (rtos dis Dunits Dprec) ; returns distance as a text string ) (entmake (list (cons 0 "TEXT") (cons 10 angtxtpos) (cons 40 txtheight) (cons 1 angtxt) (cons 50 (cadr angtxtval)) (cons 72 1) (cons 11 angtxtpos))) (entmake (list (cons 0 "TEXT") (cons 10 distxtpos) (cons 40 txtheight) (cons 1 distxt) (cons 50 (cadr angtxtval)) (cons 72 1) (cons 11 distxtpos))) ) ; end PlaceText ; Begin Main Program ;------------------------------------------------------------------------------ (princ "\nSelect LINES or LWPOLYLINES to attach Bearing Distance to") ; Provide prompt (setq sset (ssget '((-4 . "<or")(0 . "LINE")(0 . "LWPOLYLINE")(-4 . "or>")))) ; select only LINES or Light Weight Polylines (if sset (progn (setq num 0) ; zero counter ; Scale factor. Find drawing scale factor (setq scalefac (getdwgscale)) (repeat (sslength sset) ; repeat for each object in the selection set (setq ent (entget(ssname sset num))) ; find entity properties (cond ((= (cdr (assoc 0 ent)) "LINE") (setq startpt (cdr (assoc 10 ent))) ; find the start point of the line (setq endpt (cdr (assoc 11 ent))) ; find the end point of the line (PlaceText startpt endpt scalefac) ; Place Bearing Distance Text ) ((= (cdr (assoc 0 ent)) "LWPOLYLINE") (setq VerLst (ListPlineVer ent)) ; find all the vertices for the pline (setq ctr 0) ; Zero Counter ; Step through each vertice in list and place bearing distance text accordingly (if (= 1 (boole 1 1 (cdr (assoc 70 ent)))) ; check if the pline is Open or Closed (repeat (setq lstlen (length VerLst)) ; Assoc 70 = 1 pline Closed (if (= (1+ ctr) lstlen) ; Check if we are at the last vertice in the list (setq startpt (nth ctr verlst) endpt (nth 0 verlst) ; endpoint = 1st vertice in list ) (setq startpt (nth ctr verlst) endpt (nth (1+ ctr) verlst) ) ) (PlaceText startpt endpt scalefac) ; Place Bearing Distance Text (setq ctr (1+ ctr)) ; iterate counter to next vertice in point list ) (repeat (1- (length VerLst)) ; Assoc 70 = 0 pline Open (setq startpt (nth ctr verlst) endpt (nth (1+ ctr) verlst) ) (PlaceText startpt endpt scalefac) ; Place Bearing Distance Text (setq ctr (1+ ctr)) ; iterate counter to next vertice in point list ) ) ) ) (setq num (1+ num)) ; Iterate counter to next object in selection set ) ) (princ "\nNo lines selected\n") ) ) ;end main function ;(C:BD) ; run automatically on loading Quote
alanjt Posted June 18, 2013 Posted June 18, 2013 Change (angtos (cadr angtxtval) Bunits Bprec) to (angtos (cadr angtxtval) 2 Bprec) Quote
Guest Posted June 18, 2013 Posted June 18, 2013 can i ask somethind else ?? I need the text to be little closer to the line.How can i do it ?? 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.