(i could not send an attachment so am pasting it)
; pav.lsp pline add vertices with elevations by alex konieczka with great
help from Rakesh Rao, and Michael Puckett and rodny estep.
(defun c:pav ()
(setq vlist nil plist nil dy 0 cnt 0)
(setq el1 (getreal "Enter starting elev: "))
(print "Select pline: ")(gent)
(if (= (ass 0) "LWPOLYLINE") (progn (setq ename (ass -1)))(progn (print
"Must be a pline.")(quit)))
(command "area" "ob" ename)
(setq l (getvar "perimeter") slen 5.0)
(setq divs (fix (/ l slen)))
(initget 0 "1 2")
(setq dr1 (getkword "\nEnter Choice: 1. Elev 2. Slope "))
(if (= dr1 "1")
(progn (setq el2 (getreal "Enter ending elev: ") slope (/ (- el2 el1) l)
el2 (+ el1 (* slope l)) dy (/ (- el2 el1) (/ l slen)) ) )
(progn (setq slope (/ (getreal "Enter slope% (e.g. 2 = 0.02:") 100.0) el2
(+ el1 (* slope l)) dy (/ (- el2 el1) (/ l slen)) ))
)
(PL_DividedPoints ename divs)
(foreach n vlist (progn
(setq pt (nth cnt vlist) pt (list (car pt) (cadr pt) (+ el1 (* cnt dy)) ))
(setq plist (append (list pt) plist))
(setq cnt (1+ cnt)) ))
(Make3DPoly plist)
(princ))
;/////////
; make poly function
(defun Make3DPoly ( pointlist / lastent )
(setq lastent (entlast))
(foreach definition
(append
'((
(0 . "POLYLINE")
(100 . "AcDbEntity")
(100 . "AcDb3dPolyline")
(66 . 1)
(10 0.0 0.0 0.0)
(70 . 8)
(40 . 0.0)
(41 . 0.0)
(210 0.0 0.0 1.0)
(71 . 0)
(72 . 0)
(73 . 0)
(74 . 0)
(75 . 0)
))
(mapcar
'(lambda (point)
(append
'( (0 . "VERTEX")
(100 . "AcDbEntity")
(100 . "AcDbVertex")
(100 . "AcDb3dPolylineVertex")
)
(list (cons 10 point))
'( (40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(70 . 32)
(50 . 0.0)
(71 . 0)
(72 . 0)
(73 . 0)
(74 . 0)
)
)
)
PointList
)
'((
(0 . "SEQEND")
(100 . "AcDbEntity")
))
)
(entmake definition)
)
(not (eq (entlast) lastent))
)
; subs
;; !
***************************************************************************
;; ! LI_item
;; !
***************************************************************************
;; ! Function : Returns the first occurence of a DXF dotted pair from a list
;; ! Argument : 'n' - The DXF code to check
;; ! 'alist' - The List to check
;; ! Returns : The value of the DXF dotted pair, if it exists else returns
nil
;; ! Update : December 26, 1998
(defun LI_item (n alist)
(cdr (assoc n alist))
)
;; !
****************************************************************************
;; ! PL_DividedPoints
;; !
****************************************************************************
;; ! Function : Returns the points obtained by dividing the given polyline
;; ! (either in 'entity' form or list form )
;; ! Arguments:
;; ! 'ename' - Polyline Object name or list [ overloaded ]
;; ! 'NumSegs' - Number of segments to divide the polyline into
;; ! 'prevPt' - The previous point digitized
;; ! Updated : April 26, 1999
;; ! Copyright: (C) 2000, Four Dimension Technologies, Singapore
;; ! Contact : rakesh.rao@4d-technologies.com for help/support/info
;(defun PL_DividedPoints ( ename NumSegs / vlist ss p1 p2 OS )
(defun PL_DividedPoints ( ename NumSegs )
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (= (type ename) 'ENAME)
(progn
(command "._Divide" ename NumSegs)
(setq
vlist (PL_plist ename)
p1 (car vlist)
p2 (last vlist)
ss (ssget "P")
)
)
(progn
(setq
vlist ename
p1 (car vlist)
p2 (last vlist)
ename (PL_mk_pl vlist 8 0.0)
)
(command "._Divide" ename NumSegs)
(setq ss (ssget "P"))
(entdel ename)
))
(if ss
(progn
(setq
vlist (cons p1 (SS_SS2Pt ss))
vlist (append vlist (list p2))
)
(command "._Erase" ss "")
)
(setq vlist nil)
)
(setvar "OSMODE" OS)
vlist
)
;; !
****************************************************************************
;; ! PL_plist
;; !
****************************************************************************
;; ! Function : Return list of points from an LWPOLYLINE or POLYLINE
;; ! Arguments:
;; ! 'ename' - The entity name of the polyline, line, 3dface or
;; ! spline. In case of a SPLINE, the fit points are
;; ! returned.
;; ! Action : Returns a list of all fit points of the polyline
;; ! Does not return the control points of splione polylines
;; ! or SPLINE objects.
;; ! Returns : List of all points (3D format)
;; ! Updated : Septemer 22, 1998
;; ! Copyright: (C) 2000, Four Dimension Technologies, Singapore
;; ! Contact : rakesh.rao@4d-technologies.com for help/support/info
(defun PL_plist ( ename / en entl flag vlist pt Elev )
(setq
vlist '()
entl (entget ename)
en (LI_item 0 entl)
)
(cond
((= en "LWPOLYLINE")
(setq
vlist '()
Elev (LI_item 38 entl)
)
(foreach pt entl
(if (= (car pt) 10)
(setq vlist (cons (list (cadr pt) (caddr pt) Elev) vlist))
)
)
)
((= en "SPLINE")
(setq vlist (LI_mitem 11 entl))
)
((= en "POLYLINE")
(setq
ename (entnext ename)
entl (entget ename)
en (LI_item 0 entl)
vlist '()
)
(while (= en "VERTEX")
(setq flag (LI_item 70 entl))
(if (and
(zerop (logand flag 1))
(zerop (logand flag 2))
(zerop (logand flag 8))
(/= flag 128)
)
(setq
pt (LI_item 10 entl)
vlist (cons pt vlist)
)
)
(setq
ename (entnext ename)
entl (entget ename)
en (LI_item 0 entl)
)
)
)
((= en "LINE")
(setq vlist (list (LI_item 10 entl) (LI_item 11 entl)))
)
((= en "3DFACE")
(setq vlist (list
(LI_item 10 entl) (LI_item 11 entl)
(LI_item 12 entl) (LI_item 13 entl)
)
)
)
)
(if vlist (reverse vlist) nil)
)
;; !
****************************************************************************
*
;; ! SS_ss2pt
;; !
****************************************************************************
*
;; ! Function : Convert Selection Set of points to Points List
;; ! Arguments: 'ss' - Selection Set to process
;; ! Return : A List of all DXF Code 10 values from the selection set
entities
;; ! Updated : December 30, 1998
;; ! Copyright: (C) 2000, Four Dimension Technologies, Singapore
;; ! Contact : rakesh.rao@4d-technologies.com for help/support/info
(defun SS_ss2pt ( ss / ssl cnt ename entl pt Lst )
(setq Lst '())
(if ss
(progn
(setq
ssl (sslength ss)
cnt 0
)
(repeat ssl
(setq
ename (ssname ss cnt)
entl (entget ename)
pt (LI_item 10 entl)
Lst (append Lst (list pt))
cnt (1+ cnt)
)
)
))
(if (> (length Lst) 0) Lst nil)
)
; gent returns the entity name of the item picked
(defun gent ()
(setq entn (entsel))
(setq entcodes (entget (car entn)))
(setq entpt (cadr entn))
(setq entt (cdr (assoc 0 entcodes)))
)
; ass returns the (cdr (assoc n)) of the the item. (ass 10) => (10 . 1 2 3)
(defun ass (code / )
(cdr (assoc code entcodes))
)
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
