hastan 发表于 2015-10-6 22:45 static/image/common/back.gif
可以告訴我嗎
(or (tblsearch "layer" "TPTEMP")
(command "layer" "n" "TPTEMP" "")
)
(or (tblsearch "layer" "CONTEMP")
(command "layer" "n" "CONTEMP" "")
)
(or (tblsearch "layer" "DTM3D")
(command "layer" "n" "DTM3D" "")
)
(defun c:tt (/ ss dis ps box ss v pb sss m n p0 pls pts _pi2 trilst ppt ppl
ms)
(if (and (setq dis (getdist "\nDistance of Axis: "))
(setq ps (ssget "+.:S" '((0 . "*Polyline"))))
(setq pl (ssname ps 0))
(setq pls (xlrx-curve-getstretchpoints pl))
(setq ss (ssget "x" '((0 . "insert") (2 . "99"))))
(setq sss (XLRX-TriAngle ss ps nil t))
)
(progn
(setq box (list (apply 'mapcar (cons 'min pls))
(apply 'mapcar (cons 'max pls))
)
v (mapcar 'abs (apply 'mapcar (cons '- box)))
pb (mapcar '+ (list (/ dis 2) (/ dis 2) 0.) (car box))
m (fix (/ (- (car v) (/ dis 2)) dis))
n (fix (/ (- (cadr v) (/ dis 2)) dis))
p0 pb
trilst (mapcar 'xlrx-curve-getstretchpoints
(xlrx-pickset->list sss)
)
ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(command ".layer" "F" "三角网,99" "")
(repeat m
(setq pts (cons (setq p0 (polar p0 0.0 dis)) pts))
)
(setq pts (cons pb (reverse pts))
_pi2 (/ pi 2)
ppt (apply
'append
(mapcar
'(lambda (x / p ptl)
(setq p x)
(repeat n
(setq ptl (cons (setq p (polar p _pi2 dis)) ptl))
)
(vl-remove-if
'(lambda (a) (not (XLRX-Point-IsInPoly1 a pls)))
(cons x (reverse ptl))
)
)
pts
)
)
)
(foreach x trilst
(if (setq stri
(vl-remove-if-not
(function
(lambda (a)
(apply 'xlrx-point-getTriIntersElev (cons a x))
)
)
ppt
)
);_可以再优化算法
(mapcar (function (lambda (b / pt blk)
(setq pt (apply 'xlrx-point-getTriIntersElev (cons b x))
blk (vla-insertblock
ms
(vlax-3d-point pt)
"99"
1.
1.
1.
0.
)
)
(vla-put-layer blk "TPTEMP")
(XLRX-Block-SetAtts
(entlast)
"PTELEV"
(rtos (caddr pt) 2 3)
)
(setq ppt (vl-remove b ppt))
)
)
stri
)
)
)
(if ppt
(foreach x ppt
(entmake (list '(0 . "point") (cons 10 x) '(62 . 3)))
)
)
)
)
(princ)
)