devitg Posted June 6, 2022 Posted June 6, 2022 Since 2 days I searched for Bearing and distance to draw , I only found , from Drawn , get bearing and distance . Mine question is like a kinder garden pupil at ACAD school. There is a LSP to draw polylines, or consecutives lines give this data Origin could be 0,0,0 end at vertex 9 . My source is : para lisp.png Thanks in advance Quote
exceed Posted June 7, 2022 Posted June 7, 2022 (edited) 11 hours ago, devitg said: Since 2 days I searched for Bearing and distance to draw , I only found , from Drawn , get bearing and distance . Mine question is like a kinder garden pupil at ACAD school. There is a LSP to draw polylines, or consecutives lines give this data Origin could be 0,0,0 end at vertex 9 . My source is : para lisp.png Thanks in advance you want to draw polyline? 1. get data by ctrl+c https://www.cadtutor.net/forum/topic/74663-search-clipboard-text-for-newline-character/?do=findComment&comment=591375 2. make list by LM:str->lst http://www.lee-mac.com/stringtolist.html - cbread is an example of simply reading the copied text, and cbpaste includes a way to separate rows. Columns are separated by \t . 3. make point list by (polar) from 0,0,0 origin 4. and then draw by this link https://www.afralisp.net/archive/methods/list/addpolyline_method.htm + or you can get data by excel directly https://www.cadtutor.net/forum/topic/74681-cad-output-excel-specified-page/?do=findComment&comment=591539 this is beginner level because i'm beginner, so there are a lot of overlapping parts, but I made it so that there is no problem in reading and writing data if only the row no. and column no. are known. Easy to put in a loop. Edited June 7, 2022 by exceed Quote
Isaac26a Posted June 7, 2022 Posted June 7, 2022 I don't know if this can help you with what you're trying to do but, you can do this: (command "pline" "0,0" "@181.91<0" "@230.26<81.36" "@79.44<172.0113" "@147.86<161.0922222" "@278.74<43.53611109") But the angle should be in degrees, and it's measured from the X axis to the line, I don't know how to do that with entmake, just with the points or coordinates Quote
devitg Posted June 7, 2022 Author Posted June 7, 2022 (edited) 9 minutes ago, Isaac26a said: I don't know if this can help you with what you're trying to do but, you can do this: (command "pline" "0,0" "@181.91<0" "@230.26<81.36" "@79.44<172.0113" "@147.86<161.0922222" "@278.74<43.53611109") But the angle should be in degrees, and it's measured from the X axis to the line, I don't know how to do that with entmake, just with the points or coordinates Sad to say it do not work , as I said it are INTERNAL angles from each to each side The blue lines is as it is , the brown is as your tip. Edited June 7, 2022 by devitg correct spelling Quote
exceed Posted June 7, 2022 Posted June 7, 2022 (edited) (vl-load-com) (defun c:CPOLY ( / *error* txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist srllen subindex selectedcell sclist ss1stacklist ss1count ss2 ss2count ss2index ss2y ss2list ss2stacklist ss2ent ss2x ss2index2 ss1textfromstacklist ss2obj ss1notusedlist ss1notusedstacklist ss1notusedlength ss1notusedindex ss1notusedtextstr ss1notusedtext ss1notusedtextstrlen basept index2 extang ptlist length1 intang1 point1 vertno) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (setvar 'cmdecho 1) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) (setq txtedit1 (LM:str->lst txtstring "\r\n")) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) (setq selectedrowlist (LM:str->lst selectedrow "\t")) (setq srllen (length selectedrowlist)) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) (setq ss1stacklist (mysort scstack)) (setq ss1count (length ss1stacklist)) (setq basept (list 0 0 0)) (setq index2 0) (setq extang 0) (setq ptlist (list basept)) (setq vertno 1) (repeat (/ ss1count 2) (setq length1 (atof (deletesemicolon (cadr (nth index2 ss1stacklist))))) (setq intang1 (atof (deletesemicolon (cadr (nth (+ index2 1) ss1stacklist)) ) ) ) ;(setq extang intang1) ;if it's external angle already (if (= intang1 0) (setq extang (+ extang intang1)) (setq extang (+ extang (- pi intang1))) ) (princ "\n vertex no. ") (princ vertno) (princ " ~ ") (princ (+ vertno 1)) (princ " = length - ") (princ length1) (princ " / internal angle - ") (princ intang1) (princ " (= ") (princ (rtd intang1)) (princ " deg)") (princ " / global angle - ") (princ extang) (princ " (= ") (princ (rtd extang)) (princ " deg)") (setq point1 (polar basept extang length1)) (setq ptlist (cons point1 ptlist)) (setq basept point1) (setq vertno (+ vertno 1)) (setq index2 (+ index2 2)) );end of repeat (setq ptlist (reverse ptlist)) (princ "\n point list - ") (princ ptlist) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (setq mspace (vla-get-modelspace thisdrawing)) (setq ptlist (apply 'append ptlist)) (if (= (rem (length ptlist) 3) 0) (progn (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)) ) ) (vlax-safearray-fill tmp ptlist) (setq myobj (vla-addPolyline mspace tmp)) ) (princ "\nerror: Polyline could not be created") ) (setvar 'cmdecho 1) (LM:endundo (LM:acdoc)) (princ) ) (defun deletesemicolon (x) (vl-string-subst "" (chr 59) x)) (defun dtr (x)(* pi (/ x 180.0))) (defun rtd (x) (* x (/ 180.0 pi))) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) (princ "\n CPOLY - loading complete") Ah.. I only realized your problem after writing this. so this is not completed routine. your excel has missing vertex in the middle. (3-4 and 6-7) you can find the total missing angle by using the formula for summing the interior angles of a polygon, total angle = 180*(n-2) n is number of lines but it will be difficult to distribute it. i think anyway, this works by copying only 2 columns length and internal angle. if no points are missing command prompt like this. Command: CPOLY vertex no. 1 ~ 2 = length - 181.91 / internal angle - 0.0 (= 0.0 deg) / global angle - 0.0 (= 0.0 deg) vertex no. 2 ~ 3 = length - 230.26 / internal angle - 1.48457 (= 85.0597 deg) / global angle - 1.65702 (= 94.9403 deg) vertex no. 3 ~ 4 = length - 79.44 / internal angle - 3.00217 (= 172.011 deg) / global angle - 1.79645 (= 102.929 deg) vertex no. 4 ~ 5 = length - 147.86 / internal angle - 2.81159 (= 161.092 deg) / global angle - 2.12645 (= 121.837 deg) vertex no. 5 ~ 6 = length - 278.74 / internal angle - 0.759848 (= 43.5361 deg) / global angle - 4.5082 (= 258.301 deg) vertex no. 6 ~ 7 = length - 159.8 / internal angle - 2.99865 (= 171.81 deg) / global angle - 4.65114 (= 266.491 deg) point list - ((0 0 0) (181.91 0.0 0.0) (162.081 229.405 0.0) (144.307 306.831 0.0) (66.3105 432.446 0.0) (9.78823 159.497 0.0) (0.00637736 -0.00353716 0.0)) Edited June 7, 2022 by exceed delete semicolon from data Quote
devitg Posted June 7, 2022 Author Posted June 7, 2022 (edited) @exceed I will it tomorrow , it is 11 pm here , winter time . Please try to do by reading a csv file as the attached. AS I think it would be simple to understand. Thanks for your help csv to poly.csv Edited June 7, 2022 by devitg add csv file Quote
BIGAL Posted June 7, 2022 Posted June 7, 2022 (edited) My $0.05 if its a house lot title her in AUS then its enter dist & Brg of sides. We would do this manually using enter distance, enter DDD.MMSS and a enter to finish. The only tricky bit is sometimes the brg needs 180 added. It does not use excel rather you read plan use if usefull, a bit rough pulled together quickly form a bigger survey routine. The full routine does a closure check and asks to accept rather than use pline "C". ; https://www.cadtutor.net/forum/topic/75349-how-or-where-should-i-search/ ; A rough bearing and distance entry ; For feet use multi getvals 2col.lsp so feet inches and DDD MMM SEC (defun c:brdi ( / lwpoly ang_ans ans_deg ans_min char_found ans_secs oldang ) (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst)) ) ) (setq oldang (getvar 'aunits) lst '() ) (setvar 'aunits 3) (setq p1 (getpoint "\nPick start point ")) (setq lst (cons p1 lst)) (while (/= "" (setq ang_ans (getstring "\nEnter bearing angle in Deg.MMSS :"))) (setq ans_deg "" ans_min "" ans_secs "" char_found "") (setq ans_len (strlen ang_ans)) (setq x 0) (while (/= char_found ".") (setq x (+ x 1)) (setq ans_deg (strcat ans_deg char_found)) (setq char_found (substr ang_ans x 1)) (if (= x 9)(setq char_found ".")) ) (setq x (+ x 1)) (setq ans_min (substr ang_ans x 2)) (setq x (+ x 2)) (setq ans_secs (substr ang_ans x 2)) (if (= ans_min "")(setq ans_min "0")) (if (= ans_secs "")(setq ans_secs "0")) (setq ang (dtr (+ (atof ans_deg)(/ (atof ans_min) 60.0)(/ (atof ans_secs) 3600.0)))) (princ (strcat "\n" (rtos ang 2 3))) (setq dist (getdist "\nLength of boundary ? (m) :")) (setq p2 (polar p1 ang dist)) (setq lst (cons p2 lst)) (setq p1 p2) ) (setq ans (getstring "\nType C to close Enter for open ")) (if (= ans "") (setq pclose 0) (setq pclose 1) ) (LWPoly lst pclose) (setvar 'aunits oldang) (princ) ) (C:brdi) Edited June 7, 2022 by BIGAL Quote
eldon Posted June 7, 2022 Posted June 7, 2022 20 hours ago, devitg said: Since 2 days I searched for Bearing and distance to draw , I only found , from Drawn , get bearing and distance . Mine question is like a kinder garden pupil at ACAD school. There is a LSP to draw polylines, or consecutives lines give this data Origin could be 0,0,0 end at vertex 9 . I think that the answer to your original request is that no one has written such a lisp using data such as yours. From the responses, it is clear that more information is required. Quote
eldon Posted June 7, 2022 Posted June 7, 2022 The shape is easy enough to draw using your data. I assumed the vertexes go Counter-clockwise round the shape, so the internal angles are clockwise from the previous line. It is easiest to draw internal angles by drawing two lines on top of each other and then rotating one by the internal angle. The angle system does not have to be changed, just put "r" at the end of the numbers, and AutoCad knows it is a radian angle. If this shape is to be used in mapping, then the bearing of the start line is needed, as is the coordinate of the starting vertex. Quote
Steven P Posted June 7, 2022 Posted June 7, 2022 Would (polar .... ) be what you are looking for? Create a list of points and then entmake a polyline from them? (https://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-6A84BFD3-8788-45B1-AB52-5E83F0C5286E) You'd need to do a sum along the way to work out the absolute angle rather than the angle from the previous line, but since your initial table said it was all anticlockwise rotation (CCW) that makes the maths a bit easier Quote
devitg Posted June 7, 2022 Author Posted June 7, 2022 Hi @ all you , the fact is that I have to pass from PDF or jpg or whatever to DWG old surveyor planes , i my region , small mountains. like it as suggested @eldon It is easiest to draw internal angles by drawing two lines on top of each other and then rotating one by the internal angle. The angle system does not have to be changed, just put "r" at the end of the numbers, and AutoCad knows it is a radian angle. I did it so and after it I had to draw the subdivision and join as red point are divisions , tilde union or join Thanks all for your help Quote
BIGAL Posted June 8, 2022 Posted June 8, 2022 Hi devitg, can not see in image does the lines have a BRG & Dist label ? Here in AUS the angle is not shown. Can see something next to lines. Quote
devitg Posted June 8, 2022 Author Posted June 8, 2022 @BIGAL What you see , is what I did taking from a ACAD.dwg printed as PDF , It is the way our CADASTRAL system work , all online , there is no more paper . Also they offer old scanned from paper plans. I did it the same way as @eldon suggested. Quote It is easiest to draw internal angles by drawing two lines on top of each other and then rotating one by the internal angle. The angle system does not have to be changed, just put "r" at the end of the numbers, and AutoCad knows it is a radian angle. I read the data from the pdf, and did the same way as above. I have to test the way as @exceed show , I will arrange it as to read from a CSV file. I will make such csv , reading each by each polygon and type at the csv . for each polygon , then by align I fit all the new dwg. Thanks for your concerns about it. csv to poly.csv Quote
exceed Posted June 8, 2022 Posted June 8, 2022 (edited) 37 minutes ago, devitg said: @BIGAL What you see , is what I did taking from a ACAD.dwg printed as PDF , It is the way our CADASTRAL system work , all online , there is no more paper . Also they offer old scanned from paper plans. I did it the same way as @eldon suggested. I read the data from the pdf, and did the same way as above. I have to test the way as @exceed show , I will arrange it as to read from a CSV file. I will make such csv , reading each by each polygon and type at the csv . for each polygon , then by align I fit all the new dwg. Thanks for your concerns about it. csv to poly.csv 155 B · 1 download I don't know your works well, so I don't know how much accuracy you need so, this is just my funny thinking how about to use bmp lisp in this link https://www.cadtutor.net/forum/topic/75162-bmp-file-to-polyline-mosaic/ this screenshot is result of bmp, with removing background color (255 255 255) with 20% range It only prints horizontal lines or dots, so it can't be used right away, but it's convenient to grab a snap. correct ratio Larger screenshots and higher removal rates will give you better contrast and better results. Edited June 8, 2022 by exceed Quote
BIGAL Posted June 8, 2022 Posted June 8, 2022 (edited) Hi devitg can you zoom in on a line there is something there but image is hard to see. Is it BRG & Dist ? That is the way my code is written enter values from plan. Edited June 8, 2022 by BIGAL Quote
Jamescalabut Posted July 24, 2022 Posted July 24, 2022 Hello, I Think it's simple. All you have to know is that given two alignments, p1-p2 and p2p3, measuring counterclockwise, the internal angle is related to the "angle" used in the command "polar". The internal angle is equal to pi plus the bearing of the first alignment minus the bearing of the second alignment, thus, the second bearing, which is what you are looking for is pi plus the first bearing minus the internal angle. For example, I drew the last alignment this way: (command "_line" p5 (setq p6 (polar p5 4.50818634715917 278.74)) "") If you start from an excel spreadsheet, you can get all the points there. I give you all of them. I'll upload the lisp asap, but you've got the solution right now. Plan.ods Plan.dwg Quote
Jamescalabut Posted July 24, 2022 Posted July 24, 2022 Hello again, Assuming you get the lists of the points and angles, it would go more or less like this, supposing the first bearing is 0 as you said. If not, it's easy to change: (defun c:plan() (setq distances (list 1 2 3 4) angles (list 1 2 3 4)) (setq angles2 angles) (setq bear (list 0) angles2 (cdr angles2) distances2 (cdr distances) points (list (list 0 0))) (while (setq bear (cons (+ pi (- (car bear) (car angles2))) bear)) (setq points (cons (polar (car points) (car bear) (car distances2)) points)) (command "_line" (car points) (cadr points) "") (setq angles2 (cdr angles2)) ) (command "_line" (car points) (list 0 0) "") ) 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.