Strydaris Posted November 22, 2024 Posted November 22, 2024 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. 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. Quote
BIGAL Posted November 22, 2024 Posted November 22, 2024 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 ? Quote
Strydaris Posted November 22, 2024 Author Posted November 22, 2024 @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 Quote
Jonathan Handojo Posted November 25, 2024 Posted November 25, 2024 Some suggestions: You can get rid of Degrees->Radians and use (cvunit 90 "degrees" "radians") I would opt for using vector calculations instead of trigonometry and pythagoras. So for example: (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) ) 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. Quote
BIGAL Posted November 25, 2024 Posted November 25, 2024 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. ; 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) ) Quote
Strydaris Posted November 25, 2024 Author Posted November 25, 2024 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. 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. Quote
Strydaris Posted January 6 Author Posted January 6 Just wanted to give an update on this LISP. I have completed it and it works great. One of the main issues I was having was the varying points of intersections and / or the varying length of the start and end points. These would make my line length change often based on the angle of the slope. I am not as well versed in LISP coding as some of you, so the only way I could make it work was to first put the 6" offset points into a list and if the points intersected use the intersection point. This gave me a result that looked something like this if I drew the line between the points in the list. (Result is slightly offset from original to show both) I then had to cycle through the list, create a new list to hold the new points. If the point n and point (1+ n) where straight, just added the points to the new list, if they were on an angle then do the stepping then add the points to the list as the steps are created. To finish it off, if the last point is on a straight line then go up 6 but if its on an angle than subst the straight up for the hypotenuse. Results look great and no errors. Probably not the most optimized code, but it works well. (defun c:flashing ( / ang ang2 dx dy endpt firstsegement flsh_clay flsh_cmde flsh_osm flsh_ver fnl-lst hyp lay magnitude n newp1 newp2 npt-lst p1 p2 prevp1 prevp2 pt-lst ptang ptang2 rise run shiftvec startpt stp1 stp2 unitvecperp units) (setq flsh_ver "1.0 Beta") ;;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 0);;Printable 0=Yes 1=No (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"))) ) ) ) ;;;Settings the system variables and layers (setq lay "WD-Flashing" flsh_osm (getvar "osmode") flsh_cmde (getvar "cmdecho") flsh_clay (getvar "clayer") ) ;_ setq (setvar "clayer" lay) (setvar "osmode" 33) (setvar "cmdecho" 0) (princ (strcat "\nMasonry Flashing, Version " flsh_ver ", (c) 2025-2030 by R P. " ) ;_ strcat ) ;_ princ (if (= Units nil) (setq Units (getvar "dimlunit")) ) (cond ((= Units 4) ;;;THIS IS THE IMPERIAL OFFSET NUMBERS (setq stephgt 6.0 ;;;Set the step and offset height htchsize 1.0 ;;;Sets the hatch scale ) ) ((= Units 2) ;;;;THIS IS THE METRIC OFFSET NUMBERS (setq stephgt 150.0 ;;;;Set the step and offset height htchsize 25.0 ;;;Sets the hatch scale ) ) ) ;;; ==================== Start Command =========================== (setq p1 (getpoint "\nSelect the first point: ") pt-lst (list p1) firstSegment t ) (while (setq p2 (getpoint p1 "\nSelect the next point: ")) (setq ang (angle p1 p2) ang2 (- (/ pi 2.) ang) ) (setq rise (if (>= (atof (rtos (cadr p2) 2 5)) (atof (rtos (cadr p1) 2 5))) stephgt (- stephgt)));y value (setq run (abs (* rise (/ (sin ang2)(cos ang2))));x value run (if (> (car p2) (car p1)) run (- run)) );_ setq (setq pt-lst (cons p2 pt-lst) dx (- (car p2) (car p1)) dy (- (cadr p2) (cadr p1)) magnitude (sqrt (+ (* dx dx) (* dy dy)));This can also be (dist (distance p1 p2)) unitVecPerp (list (/ (- dy) magnitude) (/ dx magnitude)) );_ setq (if (< (cadr unitVecPerp) 0) (setq unitVecPerp (list (- (car unitVecPerp)) (- (cadr unitVecPerp)))) );_ if (setq shiftVec (mapcar '(lambda (x) (* (abs rise) x)) unitVecPerp) newP1 (mapcar '+ p1 shiftVec) newP2 (mapcar '+ newP1 (list dx dy)) hyp (abs (/ rise (sin ang2))) );_ setq (if firstSegment (progn (setq firstSegment nil) (if (and (/= ang (Degrees->Radians 0)) (/= ang (Degrees->Radians 180)) (/= ang (Degrees->Radians 360))) (progn (setq startpt (polar p1 (/ pi 2) hyp) npt-lst (cons startpt npt-lst)) );_ progn (setq npt-lst (cons newp1 npt-lst)) );_ if );progn );_ if (if (and (boundp 'prevP1) (boundp 'prevP2)) (if (inters prevP1 prevP2 newP1 newP2 nil) (progn (setq npt-lst (cons (inters prevP1 prevP2 newP1 newP2 nil) npt-lst)) ) );_ if );_ if (setq prevP1 newP1 prevP2 newP2 p1 p2 endpt p2) );_ while (if (and (/= ang (Degrees->Radians 0)) (/= ang (Degrees->Radians 180)) (/= ang (Degrees->Radians 360))) (progn (setq endpt (polar endpt (/ pi 2) hyp) npt-lst (cons endpt npt-lst)) );_ progn (setq npt-lst (cons newp2 npt-lst)) );_ if ;Cycle through the npt-lst, make the final lst (setq npt-lst (reverse npt-lst)) (setq n 0) (setq fnl-lst (cons (car npt-lst) fnl-lst)) (while (< n (1- (length npt-lst))); Loop through pairs of points in the list (setq ptang (angle (nth n npt-lst)(nth (1+ n) npt-lst)) ptang2 (- (/ pi 2.) ptang)) (cond ((or (equal ptang 0 0.0001)(equal ptang (Degrees->Radians 180) 0.0001)(equal ptang (Degrees->Radians 360) 0.0001)) (setq fnl-lst (cons (nth (1+ n) npt-lst) fnl-lst)) );_ cond 1 ((and (> ptang 0)(< ptang (Degrees->Radians 180)));left to right, low to high (setq dx (- (car (nth (1+ n) npt-lst)) (car (nth n npt-lst))) dy (- (cadr (nth (1+ n) npt-lst)) (cadr (nth n npt-lst))) stp1 (nth n npt-lst) rise (if (>= (atof (rtos (cadr (nth (1+ n) npt-lst)) 2 5)) (atof (rtos (cadr (nth n npt-lst)) 2 5))) stephgt (- stephgt));y value run (abs (* rise (/ (sin ptang2)(cos ptang2))));x value run (if (> (car (nth (1+ n) npt-lst)) (car (nth n npt-lst))) run (- run)) );_ setq (repeat (abs (fix (/ dy rise))) (setq stp2 (mapcar '+ stp1 (list 0.0 rise)) fnl-lst (cons stp2 fnl-lst) stp1 stp2) (setq stp2 (mapcar '+ stp1 (list run 0.0)) fnl-lst (cons stp2 fnl-lst) stp1 stp2) );_ repeat ;;Vertical Leftovers at the end (setq fnl-lst (cons (polar stp2 (/ pi 2) (- dy (* rise (fix (/ dy rise))))) fnl-lst)) (setq fnl-lst (cons (nth (1+ n) npt-lst) fnl-lst)) );_ cond 1 ((and (> ptang (Degrees->Radians 180))(< ptang (Degrees->Radians 360))) (setq dx (- (car (nth (1+ n) npt-lst)) (car (nth n npt-lst))) dy (- (cadr (nth (1+ n) npt-lst)) (cadr (nth n npt-lst))) stp1 (nth n npt-lst) rise (if (>= (atof (rtos (cadr (nth (1+ n) npt-lst)) 2 5)) (atof (rtos (cadr (nth n npt-lst)) 2 5))) stephgt (- stephgt));y value run (abs (* rise (/ (sin ptang2)(cos ptang2))));x value run (if (> (car (nth (1+ n) npt-lst)) (car (nth n npt-lst))) run (- run)) );_ setq ;;Verticals Leftovers at the start (setq fnl-lst (cons (polar stp1 0 (- dx (* run (fix (/ dx run))))) fnl-lst)) (setq fnl-lst (cons (polar (polar stp1 0 (- dx (* run (fix (/ dx run))))) (/ pi 2)(- dy (* rise (fix (/ dy rise))))) fnl-lst)) (setq stp1 (polar (polar stp1 0 (- dx (* run (fix (/ dx run))))) (/ pi 2)(- dy (* rise (fix (/ dy rise)))))) (repeat (abs (fix (/ dy rise))) (setq stp2 (mapcar '+ stp1 (list run 0.0)) fnl-lst (cons stp2 fnl-lst) stp1 stp2) (setq stp2 (mapcar '+ stp1 (list 0.0 rise)) fnl-lst (cons stp2 fnl-lst) stp1 stp2) );_ repeat );_ cond 2 );_ cond main (setq n (1+ n)) );_ while ;(lwpoly (reverse npt-lst)) (lwpoly (append pt-lst (reverse fnl-lst))) (command "-hatch" "_s" (entlast) "" "_p" "_u" "90" htchsize "_n" "_co" "" "_t" "255,255,255" "LA" "." "T" "0" "") (setvar "osmode" flsh_osm) (setvar "cmdecho" flsh_cmde) (setvar "clayer" flsh_clay) );_ 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) ) ;_ list (mapcar (function (lambda (p) (cons 10 p))) lst) ) ;_ append ) ;_ entmakex ) ;_ defun (defun Degrees->Radians (numberOfDegrees) (* pi (/ numberOfDegrees 180.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.