Baçon
10th May 2005, 07:38 pm
Can anyone please tell me wht's wrong with this code?
Thanks
(defun getEnt (lst / ent)
(setvar "ERRNO" 0)
(while (and (not ent) (/= (getvar "ERRNO") 52))
(cond ((setq ent (car (entsel)))
(if (not (member (cdr (assoc 0 (entget ent))) lst))
(setq ent nil)
)
)
)
)
ent
)
(defun getSegments (/ s1 s2)
(setq s1 (max (getvar "SURFTAB1") 6)
s2 (max (getvar "SURFTAB2") 12)
)
(list (cond ((getint (strcat "\nSpecify horizontal segmentation <" (itoa s1) ">: ")))
(s1)
)
(cond ((getint (strcat "\nSpecify vertical segments <" (itoa s2) ">: ")))
(s2)
)
)
)
(defun getVertices (curve segh / vlst n v p offset osm)
(setq n (vlax-curve-getStartParam curve)
v (vlax-curve-getEndParam curve)
offset (/ 1.0 segh)
osm (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(while (< n v)
(setq p n)
;; use EQUAL to adjust for small decimal deviations
;; otherwise it could just be (< p (1+ n))
(while (not (equal p (1+ n) 1.0E-6))
(setq
vlst (cons (vlax-curve-getPointAtParam curve p) vlst)
p (+ p offset)
)
)
(setq n (1+ n))
)
(setvar "OSMODE" osm)
(reverse vlst)
)
(defun dtr (ang)(/ (* ang pi) 180.0))
(defun C:FLUTEX (/ osm mlist angcnt angincr cpt end_ang ent hgt
mlen nlen obj ptlist rot result seg1 seg2 st_ang
z
)
(cond ((setq ent (getEnt '("LWPOLYLINE")))
(mapcar 'set '(seg1 seg2) (getSegments))
(setq rot (getreal "\nSpeficy rotation in degr.: ")
hgt (getdist "\nSpecify height: ")
)
(setq obj (vlax-ename->vla-object ent))
)
)
;; check if all stuff is ok
(cond ((and obj (apply 'and (mapcar 'numberp (list seg1 seg2 rot hgt))))
;; ready to extract points from obj
(cond ((and (setq ptlist (getVertices obj seg1))
(setq cpt (getpoint "\nCenter of rotation: "))
(setq taper (cond ((getdist "\nTaper distance <0.0>: "))
(T 0.0)
)
)
)
(setq mlist (cons ptlist mlist)
mlen (length ptlist)
)
;; first point set is already added to mlist,
;; so set hgtcnt to one step up the z-ladder
(setq rot (dtr rot)
hgtcnt (/ hgt seg2)
hgtincr hgtcnt
cpt (list (car cpt)(cadr cpt) hgtcnt)
angincr (/ rot seg2)
tcnt 0.0
tincr (/ taper seg2)
stpt (list (caar ptlist)(cadar ptlist) hgtcnt)
angcnt (angle cpt stpt)
osm (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(command "UNDO" "Begin")
(while
(and (apply 'and ptlist) (<= hgtcnt hgt))
;;(< angcnt end_ang))
(setq ptlist
(mapcar
(function (lambda (pt / npt)
(setq npt (list (car pt) (cadr pt) hgtcnt))
(setq npt (polar cpt
(+ (angle cpt npt) angincr)
(- (distance cpt npt) tcnt)))
)
)
ptlist
)
)
(setq hgtcnt (+ hgtcnt hgtincr)
cpt (list (car cpt) (cadr cpt) hgtcnt)
angcnt (+ angcnt angincr)
tcnt (+ tcnt tincr)
)
(setq mlist (cons ptlist mlist))
)
(princ (setq nlen (length mlist)))
(cond
((entmake
(list '(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(8 . "0")
'(100 . "AcDbPolygonMesh")
'(66 . 1)
'(10 0.0 0.0 0.0)
(cons 70 (+ 16 32))
'(40 . 0.0)
'(41 . 0.0)
'(210 0.0 0.0 1.0)
(cons 71 nlen)
(cons 72 mlen)
'(73 . 0)
'(74 . 0)
'(75 . 0)
)
)
(foreach mrow mlist
(foreach nrow mrow
(entmake (list '(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbPolygonMesh")
'(100 . "AcDbPolygonMesh")
(cons 10 nrow)
'(70 . 64)
)
)
)
)
(setq result (entmake (list '(0 . "SEQEND"))))
)
)
(setvar "OSMODE" osm)
(command "UNDO" "End")
)
)
)
)
)
Thanks
(defun getEnt (lst / ent)
(setvar "ERRNO" 0)
(while (and (not ent) (/= (getvar "ERRNO") 52))
(cond ((setq ent (car (entsel)))
(if (not (member (cdr (assoc 0 (entget ent))) lst))
(setq ent nil)
)
)
)
)
ent
)
(defun getSegments (/ s1 s2)
(setq s1 (max (getvar "SURFTAB1") 6)
s2 (max (getvar "SURFTAB2") 12)
)
(list (cond ((getint (strcat "\nSpecify horizontal segmentation <" (itoa s1) ">: ")))
(s1)
)
(cond ((getint (strcat "\nSpecify vertical segments <" (itoa s2) ">: ")))
(s2)
)
)
)
(defun getVertices (curve segh / vlst n v p offset osm)
(setq n (vlax-curve-getStartParam curve)
v (vlax-curve-getEndParam curve)
offset (/ 1.0 segh)
osm (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(while (< n v)
(setq p n)
;; use EQUAL to adjust for small decimal deviations
;; otherwise it could just be (< p (1+ n))
(while (not (equal p (1+ n) 1.0E-6))
(setq
vlst (cons (vlax-curve-getPointAtParam curve p) vlst)
p (+ p offset)
)
)
(setq n (1+ n))
)
(setvar "OSMODE" osm)
(reverse vlst)
)
(defun dtr (ang)(/ (* ang pi) 180.0))
(defun C:FLUTEX (/ osm mlist angcnt angincr cpt end_ang ent hgt
mlen nlen obj ptlist rot result seg1 seg2 st_ang
z
)
(cond ((setq ent (getEnt '("LWPOLYLINE")))
(mapcar 'set '(seg1 seg2) (getSegments))
(setq rot (getreal "\nSpeficy rotation in degr.: ")
hgt (getdist "\nSpecify height: ")
)
(setq obj (vlax-ename->vla-object ent))
)
)
;; check if all stuff is ok
(cond ((and obj (apply 'and (mapcar 'numberp (list seg1 seg2 rot hgt))))
;; ready to extract points from obj
(cond ((and (setq ptlist (getVertices obj seg1))
(setq cpt (getpoint "\nCenter of rotation: "))
(setq taper (cond ((getdist "\nTaper distance <0.0>: "))
(T 0.0)
)
)
)
(setq mlist (cons ptlist mlist)
mlen (length ptlist)
)
;; first point set is already added to mlist,
;; so set hgtcnt to one step up the z-ladder
(setq rot (dtr rot)
hgtcnt (/ hgt seg2)
hgtincr hgtcnt
cpt (list (car cpt)(cadr cpt) hgtcnt)
angincr (/ rot seg2)
tcnt 0.0
tincr (/ taper seg2)
stpt (list (caar ptlist)(cadar ptlist) hgtcnt)
angcnt (angle cpt stpt)
osm (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(command "UNDO" "Begin")
(while
(and (apply 'and ptlist) (<= hgtcnt hgt))
;;(< angcnt end_ang))
(setq ptlist
(mapcar
(function (lambda (pt / npt)
(setq npt (list (car pt) (cadr pt) hgtcnt))
(setq npt (polar cpt
(+ (angle cpt npt) angincr)
(- (distance cpt npt) tcnt)))
)
)
ptlist
)
)
(setq hgtcnt (+ hgtcnt hgtincr)
cpt (list (car cpt) (cadr cpt) hgtcnt)
angcnt (+ angcnt angincr)
tcnt (+ tcnt tincr)
)
(setq mlist (cons ptlist mlist))
)
(princ (setq nlen (length mlist)))
(cond
((entmake
(list '(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(8 . "0")
'(100 . "AcDbPolygonMesh")
'(66 . 1)
'(10 0.0 0.0 0.0)
(cons 70 (+ 16 32))
'(40 . 0.0)
'(41 . 0.0)
'(210 0.0 0.0 1.0)
(cons 71 nlen)
(cons 72 mlen)
'(73 . 0)
'(74 . 0)
'(75 . 0)
)
)
(foreach mrow mlist
(foreach nrow mrow
(entmake (list '(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbPolygonMesh")
'(100 . "AcDbPolygonMesh")
(cons 10 nrow)
'(70 . 64)
)
)
)
)
(setq result (entmake (list '(0 . "SEQEND"))))
)
)
(setvar "OSMODE" osm)
(command "UNDO" "End")
)
)
)
)
)