网上看到一个程序，自己改了，还是有错误，请高手帮忙看看。
网上看到一个程序，自己改了，还是有错误，请高手帮忙看看。实现效果是：根据步长和角度抽稀多一线的点(vl-load-com)
(defun cutpoint (ptsnew / pt0 pt1 pt2 pt3 pt4 dist0 dist1 dist2 ang1 ang2 len) ;末点有问题
(setq len (- (length ptsnew) 4)
pt0 (car ptsnew)
ptsnew (cdr ptsnew)
pt1 (car ptsnew)
ptsnew (cdr ptsnew)
pt2 (car ptsnew)
ptsnew (cdr ptsnew)
pt3 (car ptsnew)
ptsnew (cdr ptsnew)
return (list pt1 pt0)
dist0(distance pt0 pt1)
)
(repeat len
(setq pt4(car ptsnew)
ptsnew (cdr ptsnew)
dist1(distance pt1 pt3)
dist2(distance pt3 pt4)
)
(if (and (> dist1 0) (> (/ dist0 dist1) 0.3) (< (/ dist0 dist1) 3))
(setq ang1 ang)
(setq ang1 (/ ang 2))
)
(if (and (> dist2 0) (> (/ dist1 dist2) 0.3) (< (/ dist1 dist2) 3))
(setq ang2 ang)
(setq ang2 (/ ang 2))
)
(if (and (< dist1 dist_max) (corner pt0 pt1 pt3 ang1) (corner pt1 pt3 pt4 ang2))
t
(setq return (cons pt2 return)
dist0(distance pt2 pt1)
pt0 pt1
pt1 pt2
)
)
(setq pt2 pt3)
(setq pt3 pt4)
)
(apply 'append (cons pt4 (cons pt2 return)))
)
(defun corner (c_p1 c_p2 c_p3 c_an / c_1 c_2 temp)
(setq c_1 (angle c_p2 c_p1)
c_2 (angle c_p2 c_p3)
)
(if (< c_1 c_2)
(setq temp (abs (- c_2 c_1 pi)))
(setq temp (abs (- c_1 c_2 pi)))
)
(<= temp c_an)
)
(defun poly_pts (points / po_pts po_pt)
(setq po_pts (list (list (car points) (cadr points) 0)))
(setq points (cdddr points))
(while points
(setq po_pt(list (car points) (cadr points) 0))
(setq points (cdddr points))
(if (> (distance (car po_pts) po_pt) dist_min)
(setq po_pts (cons po_pt po_pts))
)
)
(setq po_pts (cons po_pt po_pts))
(if (> (length po_pts) 4)
(cutpoint po_pts)
)
)
(defun lwpoly_pts (points / lw_pts lw_pt)
(setq lw_pts (list (list (car points) (cadr points))))
(setq points (cddr points))
(while points
(setq lw_pt(list (car points) (cadr points)))
(setq points (cddr points))
(if (> (distance (car lw_pts) lw_pt) dist_min)
(setq lw_pts (cons lw_pt lw_pts))
)
)
(setq lw_pts (cons lw_pt lw_pts))
(if (> (length lw_pts) 4)
(cutpoint lw_pts)
)
)
(defun layer_names()
(setq e (car (entsel "\n选择图层所在的实体 :")))
(if e (progn
(setq h (cdr (assoc 8 (entget e))))
)
)
)
(defun c:choudian (/ layers dist_min dist_max ang ss m n ename object points ptsnew)
(setq layers (layer_names))
(if (= (getvar "plinetype") 2)
(setq ss (ssget (list (cons 0 "lwpolyline") (cons 8 layers))))
(setq ss (ssget (list (cons 0 "polyline") (cons 8 layers))))
)
(if ss
(progn
(setvar "cmdecho" 0)
(command "undo" "g")
(initget 6)
(if (setq dist_min (getreal "请输入最小步长:<1>"))
(setq dist_max (* dist_min 30))
(setq dist_min 1
dist_max (* dist_min 30)
)
)
(initget 6)
(if (null (setq ang (getorient "请输入最大转角:<12度>")))
(setq ang 0.21)
)
(setq m (sslength ss)
n (1- m)
)
(repeat m
(print n)
(setq ename(ssname ss n)
n (1- n)
object (vlax-ename->vla-object ename)
pts_li (vla-get-Coordinates object)
)
(if (= (getvar "plinetype") 2)
(setq ptsnew (lwpoly_pts pts_li))
(setq ptsnew (poly_pts pts_li))
)
(if (> (length ptsnew) 5)
(progn
(vla-put-Coordinates object ptsnew)
(command "pedit" ename "w" (cdr (assoc 40 (entget ename))) "")
)
)
(vlax-release-object object)
)
(command "undo" "e")
(prin1)
)
)
)
自己做个沙发，主要是在这里先感谢各位老师了。 看来高手最近都比较忙啊还的等啊
页:
[1]