Code Red > AutoLISP (Vanilla / Visual)

Help with cross section lisp

(1/4) > >>

PM:
Hi,I am using this code to create cross section drom contours. I want to update this code to ask me to pick a point on the aligment and move the 0 in the center line  and when draw the section insert a vertical line in 0 (in the possition of the aligment). My english is bad but look the image and you will understand


--- Code - Auto/Visual Lisp: --- (defun c:xsect ()  (setq os (getvar "osmode"))(setvar "osmode" 0);store users osnap settings  (setq sectline (car (entsel "\nChoose section line, "))        bp (dxfeg 10 sectline) ep (dxfeg 11 sectline);get section line endpoints, assuming an ordinary line entity for section line        ;better project these to xy plane, so....        bp (list (car bp)(cadr bp) 0.0) ep (list (car ep)(cadr ep) 0.0);section line is projected down onto xy plane        sectionintpoints nil;make a place to store all intersections between contours and this particular section line        )  (princ "\nChoose contours to sample (contours that the section line passes thru),")  (setq sscontours (ssget) i 0)  (while (< i (sslength sscontours));loop thru contours    (setq pldata (getcontourdata (ssname sscontours i));get elevation and 2d points          elev (car pldata);retrieve elevation          plis (cdr pldata);retrieve 2d point information (x and y coordinates of contour)          thiscountourintpoints nil;make a place to store intersection points for this particular contour          backcountourpoint    (car plis);store first vertex of polyline for intersection test purposes          j 0;initialize contour vertex counter    )                               (while (< j (length plis));loop thru countour vertices      (setq frontcontourpoint (nth j plis))      (cond ((null (setq ip (inters backcountourpoint frontcontourpoint bp ep))) nil);no intersection            (t;intersection found                (setq thiscountourintpoints;add to the list                    (cons (list (car ip)(cadr ip) elev) thiscountourintpoints )                   );setq             );t           );cond      (setq backcountourpoint frontcontourpoint);move up the contour.......      (setq j (1+ j));....and increment counter        );while j    ;sort by horizontal distance from bp    (setq i (1+ i))    (setq sectionintpoints (append thiscountourintpoints sectionintpoints))   );while i  ;now the list must be sorted by horizontal distance from bp  (setq sortedsectionintpoints         (vl-sort sectionintpoints '(lambda (p1 p2)(< (distance bp (list (car p1)(cadr p1)))(distance bp (list (car p2)(cadr p2))))))        )  ;draw section  (setq total_distance 0.0         lastpoint (car sortedsectionintpoints)        cdrlis (cdr sortedsectionintpoints)        )  (command "pline" (list 0.0 (caddr lastpoint)))  (foreach p cdrlis          (setq total_distance               (+ total_distance                  (distance (list (car lastpoint)(cadr lastpoint))(list (car p)(cadr p))))              )        (command (list total_distance (caddr p)))        (setq lastpoint p)    )  (command "")  ;restore user's snap settings  (setvar "osmode" os) );defun  ;..............utility....................................................(defun dxf (c eg)(cdr (assoc c eg)))(defun dxfeg (c e)(cdr (assoc c (entget e)))) ;.................................................................. (defun getcontourdata (e / mlis);return a list whose first element is elevation; rest is 2d points follow (cond  ((= "LWPOLYLINE" (dxfeg 0 e))(setq mlis (lwpolyhan e)))  ((= "POLYLINE" (dxfeg 0 e))(setq mlis (polyhan e)))  (t (setq mlis nil))  )mlis)(defun polyhan (e / plis pl p);this is for handing 3dpolylines, and it assumes the 3dpoly's vertices all have the same elevation (setq pl e plis nil elev (caddr (dxfeg 10 (entnext e)))); (while (and (setq e (entnext e))             (setq eg (entget e))             (/= "SEQEND" (dxf 0 eg))           )    (setq p (dxf 10 eg) plis (cons (list (car p)(cadr p)) plis))   )  (setq plis (if (= 1 (logand 1 (dxfeg 70 pl)));if pline is closed, tack a copy of the last vertext onto the front; reverse order either way               ;then              (cons (car plis)(reverse plis))               ;else              (reverse plis)               )        ) (cons elev plis))(defun lwpolyhan (e / eg elev datalis plis)  (setq eg (entget e) datalis eg plis nil elev (dxfeg 38 e))  (while (setq datalis (member (assoc 10 datalis) datalis))    (setq           plis (cons (cdar datalis) plis)          datalis (cdr datalis)          )    )     (setq plis (if (= 1 (logand 1 (dxfeg 70 e)));if pline is closed, tack a copy of the last vertext onto the front; reverse order either way               ;then              (cons (car plis)(reverse plis))               ;else              (reverse plis)               )        ) (cons elev plis)  )    
Thanks

PM:
Any options ?

BIGAL:
Any of the CIVIL packages will do what you want and so much more. Sometimes have to spend money to make money.

PM:
I am not using civil3d.So i need a lisp to cut the cross section from contours. To select the section line, 1 point in the the intersection of aligment and cross section line and third select contours or gine the 2 layers of the contours in the code and select then automaticaly, and draw the section with the aligment center line. Then i add a grid all elevetions


Thanks

PM:
any other ideas?

Navigation

[0] Message Index

[#] Next page