Jump to content

Create stepping lwpolyline with getpoint along lines.


Recommended Posts

Posted

Hi Everyone,

 

Was hoping someone could help me out with some idea here.

I am not looking for someone to write code for me on this because I want to learn more, but I was hoping someone could push me in the right direction a little bit.

 

I am currently using a piece of code created by Lee Mac for creating a LWpolyline using a list of points.

It looks something like this....

(defun LWPoly (lst)
  (entmakex
    (append
      (list
	(cons 0 "LWPOLYLINE")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbPolyline")
	(cons 90 (length lst))
	(cons 70 1)
      )
      (mapcar (function (lambda (p) (cons 10 p))) lst)
    )
  )
)

 

 

What I am using this for is to try and create a list of points to draw something like this...

The red lines are the user given lines.

Green lines are the resulting lines created by picking the PTs(points) along the red lines.

The white dashed lines is the constant that the green lines needs to be away from the red lines. This number is 6.

Each vertical rise in the green line is also 6, the run varies due to the angle of the red lines.

 

image.thumb.png.3af3ba07a0db5950726327c7690d867f.png

 

What I am doing is creating conditions for each angle of the selected points.

For example....

(cond ((or (= ang 0)(= ang 180)(= ang 180))
       (setq npt2 (polar pt2 (Degrees->radians 90) 6)
	         pt-list  (append pt-list (list pt2))
	         npt-list (append npt-list (list npt2))
       )
      );END COND 1

I then repeat this type of thing for each condition...

Lower left point to upper right, Upper Right to lower left, Lower RIght to Upper Left and Upper Left to Lower Right.

Then I have a bunch of setq's to do a bunch of trig math to figure out the points I need.

While this seems to be working for the most part, I figured I would ask around to see if anyone had any other ideas to reach the same results.

 

Posted

Ok dont need a list of points rather calc a point as you go. The image shows plines as insulation these are made by using the normal pline options. I am not sure that the top point will always look like that as a 6 vertical may mean it does not go through that top point. Can you post some samples in a dwg or do you alter the horizontal spacing to force a match. What is the spacing rule ?

 

 

 

Cadarc Insul.png

Posted

@Bigal

 

Hey Bigal,

I have attached the CAD file I am testing this in.

The lwpolylines on the left is me testing the lisp so far. first 2 conditions work well but there is an error I want to fix.

I do need to create the list because I need to get the length of the line (pt1 to pt2) so I can divide that by the hypotenuse to get the amount of "Steps" I need to create. then calc and add the left over amount to the end of the polyline.

Here is the code I have so far.

(defun c:flsh3 (/ )
  (setq	npt-list nil
	pt-list	nil
	f-list nil
	ang nil
	angchck nil
	dist nil
	pt1 nil
	pt2 nil
	opp 6
	)

;;Check if layers exist, if not create it
   (if (not (tblsearch "Layer" "WD-Flashing"))
      (entmake (list (cons 0 "LAYER")
		     (cons 100 "AcDbSymbolTableRecord")
		     (cons 100 "AcDbLayerTableRecord")
		     (cons 2 "WD-Flashing");;Layer Name
		     (cons 70 1);;Printable 0=No 1=Yes
		     (cons 6 "Continuous");;Linetype
		     (cons 62 14);;Colour
		     (cons 290 0)
		     (list -3 (list "AcAecLayerStandard" '(1000 . "") (cons 1000 "Working Drawing ONLY -Elevation Flashing. Use background colour 255,255,255 in hatching over brick")))
		     )
	       )
      )
    (setq lay "WD-Flashing"     ;;Sets the layer to be used by the LISP
	  			;;Settings the varibles
	  cl (getvar 'clayer)   ;;Gets the current layer
	  cmd (getvar 'cmdecho)
	  )
    (setvar 'cmdecho 0)
    (setvar 'clayer lay)
;Get the points
    (if (setq pt1 (getpoint "\nSelect First Point of Flashing: "))
		(progn
		    (setq npt1 (polar pt1 1.5708 6)
			  pt-list (append pt-list (list pt1))
			  npt-list (append npt-list (list npt1))
			  )
		    )
	)

    (while (setq pt2 (getpoint pt1 "\nSelect Next Point or [ENTER] to Exit"))
	(setq ang  (angle pt1 pt2)
	      angchck (atoi (rtos (RtD ang) 2 0))
	      dist (distance pt1 pt2)
	      )
;Start the conditions.
	(cond
	    ((or (= angchck 0)(= angchck 180)(= angchck 360))
	     (setq npt2 (polar pt2 1.5708 6)
		   pt-list (append pt-list (list pt2))
		   npt-list (append npt-list (list npt2))
		   )
	     );_cond 1
	    
;;                                         
;;START COND FOR BOTTOM LEFT TO UPPER RIGHT
;;                                         
	    ((and (> angchck 0) (< angchck 90))
	     (setq npt2     (polar pt1 (Degrees->Radians 90) (/ 6 (cos ang)))
		   pt-list  (append pt-list (list pt2));Add the selected points tothe list
		   npt-list (append npt-list (list npt2));Add the new points to the list
		   Adj      (/ Opp (/ (sin ang) (cos ang)))
		   HYP      (sqrt (+ (expt Opp 2) (expt Adj 2)))
		   div      (rtos (/ dist HYP) 2 0)
		   Xdist    (abs (- (car Pt1) (car Pt2)))
		   lftovrx  (- Xdist (* (atoi div) Adj))
		   Ydist    (abs (- (cadr Pt1) (cadr Pt2)))
		   lftovry  (- Ydist (* (atoi div) Opp))
		   )
       (repeat (atoi div)
	 (setq npt3	(polar npt2 (Degrees->Radians 90) opp)
	       npt4	(polar npt3 0 Adj)
	       npt-list	(append npt-list (list npt3) (list npt4))
	       npt2	npt4
	 )
       )
       (setq npt5     (polar npt4 (Degrees->Radians 90) lftovry)
	     npt6     (polar npt5 0 lftovrx)
	     npt-list (append npt-list (list npt5) (list npt6))
       )
      )					;END COND 2
;;                                         
;;START COND FOR UPPER LEFT TO BOTTOM RIGHT
;;
	    ((and (> angchck 270)(< angchck 360))
	     (setq npt2     (polar pt1 (Degrees->Radians 90) (/ 6 (cos ang)))
		   pt-list  (append pt-list (list pt2))
		   npt-list (append npt-list (list npt2))
		   Adj      (/ Opp (/ (sin ang) (cos ang)))
		   HYP      (sqrt (+ (expt Opp 2) (expt Adj 2)))
		   div      (rtos (/ dist HYP) 2 0)
		   Xdist    (abs (- (car Pt1) (car Pt2)))
		   lftovrx  (- Xdist (* (atoi div) (abs Adj)))
		   Ydist    (abs (- (cadr Pt1) (cadr Pt2)))
		   lftovry  (- Ydist (* (atoi div) Opp))
		   )
       (repeat (atoi div)
	 (setq npt3	(polar npt2 (degrees->radians 180) adj)
	       npt4	(polar npt3 (degrees->radians 270) opp)
	       npt-list	(append npt-list (list npt3) (list npt4))
	       npt2	npt4
	 )
       )
       (setq npt3     (polar npt4 (Degrees->radians 270) lftovry)
	     npt4     (polar npt3 (Degrees->radians 360) lftovrx)
	     npt-list (append npt-list (list npt5) (list npt6))
       )
      )					;END COND 3
;;                                         
;;START COND FOR BOTTOM RIGHT TO UPPER LEFT
;;
      ((and (> angchck 90)
	    (< angchck 180)
       )
       (setq npt2     (polar pt1 (Degrees->radians 90) 6)
	     pt-list  (append pt-list (list pt2))
	     npt-list (append npt-list (list npt2))
	     Adj      (/ Opp (/ (sin ang) (cos ang)))
	     HYP      (sqrt (+ (expt Opp 2) (expt Adj 2)))
	     div      (rtos (/ dist HYP) 2 0)
	     Xdist    (abs (- (car Pt1) (car Pt2)))
	     lftovrx  (- Xdist (* (atoi div) (abs Adj)))
	     Ydist    (abs (- (cadr Pt1) (cadr Pt2)))
	     lftovry  (- Ydist (* (atoi div) Opp))
       )
       (repeat (atoi div)
	 (setq npt3	(polar npt2 (degrees->radians 90) opp)
	       npt4	(polar npt3 0 Adj)
	       npt-list	(append npt-list (list npt3) (list npt4))
	       npt2	npt4
	 )
       )
       (setq npt5     (polar npt4 (Degrees->radians 90) lftovry)
	     npt6     (polar npt5 (Degrees->radians 180) lftovrx)
	     npt-list (append npt-list (list npt5) (list npt6))
       )
      );_cond Upper Left


	    );_cond
	
	(setq pt1 pt2)
	);_while
    (setq npt-list (reverse npt-list)
	  F-list (append F-list pt-list npt-list)
	  )
;Draw the polyline, then hatch it.    
  (LWPOLY F-list)
  ;(command "-hatch" "_s" (entlast) "" "_p" "_u" "90" "1" "_n" "_co" "" "_t" "255,255,255" "")

  (princ)
);_defun

(defun LWPoly (lst)			; LM's entmake functions
  (entmakex
    (append
      (list
	(cons 0 "LWPOLYLINE")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbPolyline")
	(cons 90 (length lst))
	(cons 70 1)
      )
      (mapcar (function (lambda (p) (cons 10 p))) lst)
    )
  )
)

(defun Degrees->Radians	(numberOfDegrees)
  (* pi (/ numberOfDegrees 180.0))
)
    

 

Flashing Test File.dwg

Posted

Some suggestions:

 

  1. You can get rid of Degrees->Radians and use
    (cvunit 90 "degrees" "radians")

     

  2. I would opt for using vector calculations instead of trigonometry and pythagoras. So for example:
  3. (setq pt1 (getpoint "\nSpecify first point <exit>: "))
    (setq pt2 (getpoint "\nSpecify first point <exit>: "))
      
    (setq 
        vec (mapcar '- pt2 pt1)
        dir (mapcar '(lambda (x) (/ x (abs x))) pt2 pt1)
    )
    
    
  4. I just moved computer, so I don't have CAD installed to review your downloaded file there, but probably this is another idea to go.
Posted

I made a start just opened a blank Notepad and started again. It was to hard for me to try to use what you had..

 

This is where I am up to and like Jonathan use mapcar.

 

image.png.00b4e1f7d1e818037d080912d641503f.png

; https://www.cadtutor.net/forum/topic/93964-create-stepping-lwpolyline-with-getpoint-along-lines/
(defun c:test ( / )
; By lee-mac
(defun LWPoly (lst)
  (entmakex
    (append
      (list
	(cons 0 "LWPOLYLINE")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbPolyline")
	(cons 90 (length lst))
	(cons 70 0)
      )
      (mapcar (function (lambda (p) (cons 10 p))) lst)
    )
  )
)

;;Check if layers exist, if not create it
   (if (not (tblsearch "Layer" "WD-Flashing"))
      (entmake (list (cons 0 "LAYER")
		     (cons 100 "AcDbSymbolTableRecord")
		     (cons 100 "AcDbLayerTableRecord")
		     (cons 2 "WD-Flashing");;Layer Name
		     (cons 70 1);;Printable 0=No 1=Yes
		     (cons 6 "Continuous");;Linetype
		     (cons 62 14);;Colour
		     (cons 290 0)
		     (list -3 (list "AcAecLayerStandard" '(1000 . "") (cons 1000 "Working Drawing ONLY -Elevation Flashing. Use background colour 255,255,255 in hatching over brick")))
		     )
	       )
      )
    (setq lay "WD-Flashing"     ;;Sets the layer to be used by the LISP
	  cl (getvar 'clayer)   ;;Gets the current layer
	  cmd (getvar 'cmdecho)
	  )
(setvar 'cmdecho 0)
(setvar 'clayer lay)
(setq oldunit (getvar 'lunits))
(setvar 'lunits 2)
(setq oldang (getvar 'aunits))
(setvar 'auints 3)
(setq oldangdir (getvar 'angdir))
(setvar 'angdir 0)

(setq pi2 (/ pi 2.0))
(setq lst '())

(setq pt1 (getpoint "\nSelect First Point of Flashing: "))
(setq lst (cons pt1 lst))
(setq pt2 (getpoint pt1 "\nSelect Next Point or [ENTER] to Exit"))
(setq ang (angle pt1 pt2))
(setq len (distance pt1 pt2))
(setq ver (abs (- (cadr pt1)(cadr pt2))))
(setq numht (fix (/ ver 6.)))
(setq hor (abs (- (car pt1)(car pt2))))
(setq numhor (fix (/ hor 6.)))
(setq ang2 (- (/ pi 2.) ang))
(setq horstep (* 6.0 (/ (sin ang2)(cos ang2))))
(setq numhor (fix (/ hor horstep)))
(setq hyp (/ 6.0 ang2))
(setq pt3 (polar pt1 pi2 (+ 6 hyp)))
(setq lst (cons pt3 lst))

(repeat numhor
(setq pt4 (mapcar '+ pt3 (list horstep 0.0 0.0)))
(setq lst (cons pt4 lst))
(setq pt3 pt4)
(setq pt4 (mapcar '+ pt3 (list 0.0 6.0  0.0)))
(setq lst (cons pt4 lst))
(setq pt3 pt4)
)
(LWPoly lst)
)

 

 

Posted

Hi @Jonathan Handojo

 

Thanks for the tips.

I am trying to learn how to use mapcar better, but it still kind of of confuses me on how to use it. I am getting there but not 100% yet.

 

What I am trying to do now is break this down into subfunctions so its a bit more understandable. I don't get to work on LISP coding as often as I would like so I get lost in some of the code I write. I add comments and maybe using subfunctions would help keep things a bit simpler.

 

@BIGAL LOL ya my code is a bit messy. I get lost in it too sometimes. That's why I add comments here and there so I remember what something does.

I was trying to keep away from all the setq variables, but while playing around with this over the weekend I don't think its going to be possible to do what I want without all the variables.

 

What I figured out over the weekend is that it may be easier to break it down into subfunctions.

Also at some point I think I need to use the inters function to determine the start point of the steps when paired with another segment.

For example, the first image below shows the location of the the point with the current code that I have working right now. The second image is what I actually need the code to do.

image.png.704586e0aa2cd43e22a41c8a3d1f60d3.png         image.png.ed09de1f9274fedf6f6d71837c50913e.png

 

While doing some research inters seems to do what I need it to do.

Also when testing the code you posted, it changed everything to metric, which I assume you work on mostly.

The other thing I noticed is that the distance from the angled line in the code you posted is not a static 6". It varies depending on the angle of the line. This 6" is a requirement. You can see it in the second image above.

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...