网上看到一个程序，自己改了，还是有错误，请高手帮忙看看。

杜流浪人

网上看到一个程序，自己改了，还是有错误，请高手帮忙看看。实现效果是：根据步长和角度抽稀多一线的点
(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)
    )
  )
)

iLisp

不改的时候啥样？能用吗？你改了哪些地方？出现什么错误提示？

杜流浪人

出现的是类型错误  好像我加的那个   (defun layer_names()这个函数可能有误吧，原代码没这个函数

Free-Lancer

杜流浪人 发表于 2014-11-20 13:40
出现的是类型错误  好像我加的那个   (defun layer_names()这个函数可能有误吧，原代码没这个函数

(vla-get-Coordinates object) 出来的是 variant 不能直接作 Lisp  表 car cadr

杜流浪人

Free-Lancer 发表于 2014-11-20 15:39
(vla-get-Coordinates object) 出来的是 variant 不能直接作 Lisp  表 car cadr

请问老师  怎么样才能解决这样的问题呢

iLisp

你改成(vlax-get object 'coordinates)试试

Lisphk

杜流浪人 发表于 2014-11-20 18:21
请问老师  怎么样才能解决这样的问题呢

返回变体的值

(vlax-variant-value var)

参数

var

变量，它包含的值的数据类型为变体。

返回值

变量的值。如果变量不包含变体，则产生错误。

示例

_$ (vlax-variant-value varstr)"ghost"_$ (vlax-variant-value varint)5

杜流浪人

iLisp 发表于 2014-11-20 18:32
你改成(vlax-get object 'coordinates)试试

; 错误: 读入的 (八进制) 字符不正确: 0

st788796

pts_li (vla-get-Coordinates object)
=〉
pts_li (vlax-get object 'Coordinates)


(vla-put-Coordinates object ptsnew)
=>
(vlax-put object 'Coordinates ptsnew)

杜流浪人

st788796 发表于 2014-11-20 20:39
pts_li (vla-get-Coordinates object)
=〉
pts_li (vlax-get object 'Coordinates)

你好  老师    用你的方法改了  还是不行   

st788796

杜流浪人 发表于 2014-11-25 21:17
你好  老师    用你的方法改了  还是不行

说说你要什么功能做吧

杜流浪人

st788796 发表于 2014-11-26 14:39
说说你要什么功能做吧

多一线上 按照步长 和角度抽隙点