Jump to content

Recommended Posts

Posted

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 

image.png.82daca022a6daaf1732ea4a75d0c403e.png

 

Origin could be 0,0,0

end at vertex 9 . 

My source is :  para lisp.png 

 

Thanks in advance 

 

 

para lisp.png

Posted (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 

image.png.82daca022a6daaf1732ea4a75d0c403e.png

 

Origin could be 0,0,0

end at vertex 9 . 

My source is :  para lisp.png 

 

Thanks in advance 

 

 

para lisp.png

 

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 by exceed
Posted

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

Posted (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 

 

image.png.c9981fe5d4ab3be6283f338332d724c9.png

 

The blue lines is as it is , the brown is as your tip. 

image.png.2d105532848f609b7300b268deb43d5e.png

 

Edited by devitg
correct spelling
Posted (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))

 

cpoly2.gif
 

Edited by exceed
delete semicolon from data
Posted (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 by devitg
add csv file
Posted (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 by BIGAL
Posted
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.

Posted

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.

Posted

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

Posted

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 

 

 image.png.8ec9e90e9f39fe952fefc28eeef00594.png

 

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 

 

 

 

image.thumb.png.095c06aefef1e5c6286ccf85ebaa1fb7.png

 

Posted

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.

Posted

@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

Posted (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

 

2022-06-08%2009;51;26.PNG

 

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 by exceed
Posted (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.

 

image.png.0f093184547413be6df89187c99243f0.png

Edited by BIGAL
  • 1 month later...
Posted

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

Posted

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) "")

)

 

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...