关于vlax-curve-getPointAtDist捕捉点问题

Free-Lancer · 发表于 2013-8-26 15:02:16

newer 发表于 2013-8-26 11:12
那你手工用生成的办法，在CAD下面你要怎么做？
用 API 写了个, 前面的是个通用函数，如果用生成的方法，将参数转换到曲线上的点，生成即可，最后删除选择集

(defun c:tt (/ spa _2pi ss e typ pams start end r _spa s)
(setq spa 4.
_spa spa
_2pi (* 2. pi)
)
(if (and
(setq ss (ssget '((0 . "line,arc,circle"))))
(setq i (getint "\nDivid Num: "))
)
(progn
(xdrx_setsstodb ss 0)
(xdrx_setmark)
(while (setq e (xdrx_getentdata 0))
(if (> (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
(* i spa)
)
(progn
(setq typ (xdrx_getentdxf 0)
start (vlax-curve-getstartparam e)
end (vlax-curve-getendparam e)
)
(cond
((= typ "CIRCLE")
(setq r (xdrx_getentdxf 40)
spa (/ spa r)
start (/ spa 2.)
end (- _2pi (/ spa 2.))
)
)
((= typ "ARC")
(setq r (xdrx_getentdxf 40)
spa (/ spa r)
)
)
(t
)
)
(setq pams (xd::geom:divnumby (list i start end spa)))
(apply
'xdrx_curve_getsplitcurves
(cons e (apply
'append
pams
)
)
)
)
)
)
(if (setq s (xdrx_getss))
(progn
(xdrx_setsstodb s 1)
(while (setq e (xdrx_getentdata 1))
(if (equal (vlax-curve-getdistatparam e
(vlax-curve-getendparam e)
) _spa 1e-5
)
(xdrx_entity_delete e)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ spa _2pi ss e typ pams start end r _spa s) 
  (setq spa 4. 
        _spa spa 
        _2pi (* 2. pi) 
  ) 
  (if (and 
        (setq ss (ssget '((0 . "line,arc,circle")))) 
        (setq i (getint "\nDivid Num: ")) 
      ) 
    (progn 
      (xdrx_setsstodb ss 0) 
      (xdrx_setmark) 
      (while (setq e (xdrx_getentdata 0)) 
        (if (> (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 
               (* i spa) 
            ) 
          (progn 
            (setq typ (xdrx_getentdxf 0) 
                  start (vlax-curve-getstartparam e) 
                  end (vlax-curve-getendparam e) 
            ) 
            (cond 
              ((= typ "CIRCLE") 
                (setq r (xdrx_getentdxf 40) 
                      spa (/ spa r) 
                      start (/ spa 2.) 
                      end (- _2pi (/ spa 2.)) 
                ) 
              ) 
              ((= typ "ARC") 
                (setq r (xdrx_getentdxf 40) 
                      spa (/ spa r) 
                ) 
              ) 
              (t 
              ) 
            ) 
            (setq pams (xd::geom:divnumby (list i start end spa))) 
            (apply 
              'xdrx_curve_getsplitcurves 
              (cons e (apply 
                        'append 
                        pams 
                      ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (if (setq s (xdrx_getss)) 
        (progn 
          (xdrx_setsstodb s 1) 
          (while (setq e (xdrx_getentdata 1)) 
            (if (equal (vlax-curve-getdistatparam e 
                                                  (vlax-curve-getendparam e) 
                       ) _spa 1e-5 
                ) 
              (xdrx_entity_delete e) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

Lisphk · 发表于 2013-8-26 15:30:45

Free-Lancer 发表于 2013-8-26 15:02
newer 发表于 2013-8-26 11:12
那你手工用生成的办法，在CAD下面你要怎么做？
用 API 写了个, 前面的是个 ...

不是等分吗？起始数，终止数代表的什么？

Free-Lancer · 发表于 2013-8-26 15:36:24

[ 本帖最后由 Free-Lancer 于 2013-8-26 15:39 编辑 ]\n\n刚才是不是少发了个函数

;;参数: lst - 表 (等分数起始数结束数间隙[可选])
(defun XD::Geom:DivNumBy (lst / num start end spa v1 v ll len _len)
(setq num (car lst)
start (cadr lst)
end (caddr lst)
spa (cadddr lst)
len (- end start)
)
(if spa
(progn
(setq _len (/ (- len (* (1- num) spa)) num))
(if (> _len 0.)
(progn
(setq v1 (+ _len spa)
v (list v1 v1)
)
(repeat (1- (fix num))
(if ll
(setq ll (cons (mapcar '- (car ll) v) ll))
(setq ll (list (list (- end _len) end)))
)
)
(setq ll (cons (list start (+ start _len)) ll))
)
)
)
(progn
(setq _len (/ len num))
(repeat (1+ (fix num))
(if ll
(setq ll (cons (- (car ll) _len) ll))
(setq ll (list end))
)
)
)
)
ll
)

_$ (XD::Geom:DivNumBy '(10 0. 10.))
(0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0)
_$ (XD::Geom:DivNumBy '(10 0. 10. 0.2))
((0.0 0.82) (1.02 1.84) (2.04 2.86) (3.06 3.88) (4.08 4.9) (5.1 5.92) (6.12 6.94) (7.14 7.96) (8.16 8.98) (9.18 10.0))
_$ (XD::Geom:DivNumBy (list 10 0. (* pi 2)))
(0.0 0.628319 1.25664 1.88496 2.51327 3.14159 3.76991 4.39823 5.02655 5.65487 6.28319)
_$

xtdwynij · 发表于 2013-8-26 15:37:56

Free-Lancer 发表于 2013-8-26 15:02
newer 发表于 2013-8-26 11:12
那你手工用生成的办法，在CAD下面你要怎么做？
用 API 写了个, 前面的是个 ...

晓东老大的函数还没有抽得时间出来学习呢！等忙完这阵子就打算开始学习晓东老大的函数了！现在看了感觉有点晕晕的！老朋友有时间的话能不能写一个没有晓东函数的用系统自带的函数写一个让我学习一下呢？上一个贴中我看到你了，让我学到一招不用注册表也可以读取变量的！

Free-Lancer · 发表于 2013-8-26 16:09:17

xtdwynij 发表于 2013-8-26 15:37
晓东老大的函数还没有抽得时间出来学习呢！等忙完这阵子就打算开始学习晓东老大的函数了！现在看了感觉有 ...

V/Alisp 版, 没有优化

(defun c:tt (/ acdoc ms spa _2pi _spa)
(setq spa 4.
_spa spa
_2pi (* 2. pi)
acdoc (vla-get-activedocument (vlax-get-acad-object))
ms (vla-get-modelspace acdoc)
)
(vla-startundomark acdoc)
(vl-catch-all-apply
(function
(lambda (/ ss i sl n e typ pams start end r)
(if (and (setq ss (ssget '((0 . "line,arc,circle"))))
(setq i (getint "\nDivid Num: "))
)
(progn
(setq sl (sslength ss)
n -1
)
(repeat sl
(setq e (ssname ss (setq n (1+ n)))
el (entget e)
typ (cdr (assoc 0 el))
)
(if (> (vlax-curve-getdistatparam
e
(vlax-curve-getendparam e)
)
(* i spa)
)
(progn
(setq start (vlax-curve-getstartparam e)
end (vlax-curve-getendparam e)
)
(cond
((= typ "CIRCLE")
(setq r (cdr (assoc 40 el))
spa (/ spa r)
start (/ spa 2.)
end (- _2pi (/ spa 2.))
)
(setq
pams
(xd::geom:divnumby (list i start end spa))
)
(setq el (vl-remove-if
'(lambda (x)
(vl-position (car x) '(-1 0 5 100))
)
el
)
)
(foreach x pams
(entmake
(append
(cons '(0 . "ARC") el)
'((100 . "AcDbEntity") (100 . "AcDbArc"))
(list (cons 50 (car x)))
(list (cons 51 (cadr x)))
)
)
)
)
((= typ "ARC")
(setq r (cdr (assoc 40 el))
spa (/ spa r)
)
(setq
pams
(xd::geom:divnumby (list i start end spa))
)
(foreach x pams
(setq el (subst (cons 50 (car x)) (assoc 50 el) el)
el (subst (cons 51 (cadr x)) (assoc 51 el) el)
)
(entmake el)
)
)
(t
(setq
pams (xd::geom:divnumby (list i start end spa))
)
(foreach x pams
(setq el (subst
(cons
10
(vlax-curve-getpointatparam e (car x))
)
(assoc 10 el)
el
)
el (subst
(cons
11
(vlax-curve-getpointatparam e (cadr x))
)
(assoc 11 el)
el
)
)
(entmake el)
)
)
)
)
)
(setq spa _spa)
)
(vl-cmdf ".erase" ss "")
)
)
)
)
)
(vla-endundomark acdoc)
(princ)
)

(defun c:tt (/ acdoc ms spa _2pi _spa) 
  (setq spa   4. 
 _spa  spa 
 _2pi  (* 2. pi) 
 acdoc (vla-get-activedocument (vlax-get-acad-object)) 
 ms    (vla-get-modelspace acdoc) 
  ) 
  (vla-startundomark acdoc) 
  (vl-catch-all-apply 
    (function 
      (lambda (/ ss i sl n e typ pams start end r) 
 (if (and (setq ss (ssget '((0 . "line,arc,circle")))) 
   (setq i (getint "\nDivid Num: ")) 
     ) 
   (progn 
     (setq sl (sslength ss) 
    n  -1 
     ) 
     (repeat sl 
       (setq e (ssname ss (setq n (1+ n))) 
      el (entget e) 
      typ (cdr (assoc 0 el)) 
       ) 
       (if (> (vlax-curve-getdistatparam 
         e 
         (vlax-curve-getendparam e) 
       ) 
       (* i spa) 
    ) 
  (progn 
    (setq start (vlax-curve-getstartparam e) 
   end   (vlax-curve-getendparam e) 
    ) 
    (cond 
      ((= typ "CIRCLE") 
       (setq r  (cdr (assoc 40 el)) 
      spa  (/ spa r) 
      start (/ spa 2.) 
      end  (- _2pi (/ spa 2.)) 
       ) 
       (setq 
         pams 
   (xd::geom:divnumby (list i start end spa)) 
       ) 
       (setq el (vl-remove-if 
    '(lambda (x) 
       (vl-position (car x) '(-1 0 5 100)) 
     ) 
    el 
         ) 
       ) 
       (foreach x pams 
         (entmake 
    (append 
      (cons '(0 . "ARC") el) 
      '((100 . "AcDbEntity") (100 . "AcDbArc")) 
      (list (cons 50 (car x))) 
      (list (cons 51 (cadr x))) 
    ) 
         ) 
       ) 
      ) 
      ((= typ "ARC") 
       (setq r   (cdr (assoc 40 el)) 
      spa (/ spa r) 
       ) 
       (setq 
         pams 
   (xd::geom:divnumby (list i start end spa)) 
       ) 
       (foreach x pams 
         (setq el (subst (cons 50 (car x)) (assoc 50 el) el) 
        el (subst (cons 51 (cadr x)) (assoc 51 el) el) 
         ) 
         (entmake el) 
       ) 
      ) 
      (t 
       (setq 
         pams (xd::geom:divnumby (list i start end spa)) 
       ) 
       (foreach x pams 
         (setq el (subst 
      (cons 
        10 
        (vlax-curve-getpointatparam e (car x)) 
      ) 
      (assoc 10 el) 
      el 
    ) 
        el (subst 
      (cons 
        11 
        (vlax-curve-getpointatparam e (cadr x)) 
      ) 
      (assoc 11 el) 
      el 
    ) 
         ) 
         (entmake el) 
       ) 
      ) 
    ) 
  ) 
       ) 
       (setq spa _spa) 
     ) 
     (vl-cmdf ".erase" ss "") 
   ) 
 ) 
      ) 
    ) 
  ) 
  (vla-endundomark acdoc) 
  (princ) 
)

xtdwynij · 发表于 2013-8-26 16:28:50

Free-Lancer 发表于 2013-8-26 16:09
V/Alisp 版, 没有优化

多谢出手相助！我想回去看一下我又可以把我的函数改了！嘿嘿！{:soso_e183:}

Free-Lancer · 发表于 2013-8-26 16:31:29

xtdwynij 发表于 2013-8-26 16:28
多谢出手相助！我想回去看一下我又可以把我的函数改了！嘿嘿！

把你的函数发上来瞧瞧:)

xtdwynij · 发表于 2013-8-27 10:31:29

Free-Lancer 发表于 2013-8-26 16:31
把你的函数发上来瞧瞧

还没有学习你的函数呢！改完必发上来。不过可能要久一点，因为很忙啊！学习了你的函数打算把你教的取值也用上！完整了之后这个功能就不再做了！

xtdwynij · 发表于 2013-8-30 15:09:17

发觉有点奇怪，用这函数循环三次或者大于三次就不灵了，昨天首先生成前后圆弧，最后用循环生成中间圆弧三次过后就不灵了

xtdwynij · 发表于 2013-8-30 15:11:39

用此函数循环取点二次过后就不灵了，不知为什么

newer · 发表于 2013-8-30 16:32:27

xtdwynij 发表于 2013-8-30 15:09
发觉有点奇怪，用这函数循环三次或者大于三次就不灵了，昨天首先生成前后圆弧，最后用循环生成中间圆弧三次 ...

有不灵就肯定代码不完善，你不贴代码，谁也分析不出来。

xtdwynij · 发表于 2013-8-31 11:43:21

昨天用的手机上没有办法贴上代码，晚上回家测试如下：

(defun c:tt ()
(setq cqw 4 cqwgs 4)
(setq ent (car (entsel)))
(setq zhobj (vlax-ename->vla-object ent))
(setq arclen (vla-get-ArcLength zhobj))
(setq arcdist (/ (- arclen (* cqw cqwgs)) (1+ cqwgs)))
(setq arcstart (vlax-curve-getstartpoint zhobj))
(repeat cqwgs
(setq arcpt2 (vlax-curve-getPointAtDist zhobj arcdist));初始点
(princ arcpt2)
(setq arcdist (+ arcdist arcdist))
)
)
; (311.237 188.839 0.0)(286.751 188.195 0.0)(238.694 179.062 0.0)nil392.101

xtdwynij · 发表于 2013-8-31 11:46:13

Free-Lancer 发表于 2013-8-26 15:36
[ 本帖最后由 Free-Lancer 于 2013-8-26 15:39 编辑 ]\n\n刚才是不是少发了个函数
_$ (XD::GeomivNumBy ...

老朋友你好！不知道是否还关注着此贴，你的这个程序ll值之前并没有值的，你写上(if ll (... ...))；这不是白写么？因为ll在这之前我没有看到有值呀。但是你比我这菜鸟高明了不知道多少倍，我看不懂这句代码，如果有看到可以解释一下么？

newer · 发表于 2013-8-31 12:36:21

xtdwynij 发表于 2013-8-31 11:43
昨天用的手机上没有办法贴上代码，晚上回家测试如下：

(setq cqw 4 cqwgs 4)

你程序里面，上面这两个变量都代表什么意思？

Free-Lancer · 发表于 2013-8-31 13:11:58

xtdwynij 发表于 2013-8-31 11:46
老朋友你好！不知道是否还关注着此贴，你的这个程序ll值之前并没有值的，你写上(if ll (... ...))；这不 ...

你还没有理解 XD::Geom:DivNumBy 函数，这个函数是将 Pamarm 分段，应用时用 vlax-curve-getpointatparam 就可以转换为点
对Line 而言 Param 起始为 0 ，结束 Param 和线长数相等；
对 Arc Circle 上点的 Param 和该点对应的角度等值
知道这些了你就不会去用 getpointatdist 费劲去写了！下面把函数加了注释，看还有不明白吗？

;;参数: lst - 表 (等分数起始数结束数间隙[可选])
(defun XD::Geom:DivNumBy (lst / num start end spa v1 v ll len _len)
(setq num (car lst);_等分数量
start (cadr lst);_开始参数
end (caddr lst);_结束参数
spa (cadddr lst);_间隙
len (- end start);_参数总长
)
(if spa
(progn;_有间隙
(setq _len (/ (- len (* (1- num) spa)) num))
(if (> _len 0.);_确保分段总长+间隙总长 < 参数总长
(progn
(setq v1 (+ _len spa);_分段长+间隙长
v (list v1 v1);_可以看作一个向量
)
(repeat (1- (fix num));_开始分段，-1 是把 start 去除
(if ll
(setq ll (cons (mapcar '- (car ll) v) ll));_取 ll 的第一个表依次求前一段的两个参数
(setq ll (list (list (- end _len) end)));_第一次将尾端的两个数构造表
)
)
(setq ll (cons (list start (+ start _len)) ll));_这里首段单独加，用减法 start 可能出现极小值
)
)
)
(progn;_没有间隙的情况下直接分段
(setq _len (/ len num))
(repeat (1+ (fix num))
(if ll
(setq ll (cons (- (car ll) _len) ll));_ll已有的时候依次构造前一参数
(setq ll (list end));_由尾端开始，省 reverse
)
)
)
)
ll
)

;;参数: lst - 表 (等分数 起始数 结束数 间隙[可选]) 
(defun XD::Geom:DivNumBy (lst / num start end spa v1 v ll len _len) 
  (setq num   (car lst);_等分数量 
 start (cadr lst);_开始参数 
 end   (caddr lst);_结束参数 
 spa   (cadddr lst);_间隙 
 len   (- end start);_参数总长 
  ) 
  (if spa 
    (progn;_有间隙 
      (setq _len (/ (- len (* (1- num) spa)) num)) 
      (if (> _len 0.);_确保 分段总长+间隙总长 < 参数总长 
 (progn 
   (setq v1 (+ _len spa);_分段长+间隙长 
  v  (list v1 v1);_可以看作一个向量 
   ) 
   (repeat (1- (fix num));_开始分段，-1 是把 start 去除 
     (if ll 
       (setq ll (cons (mapcar '- (car ll) v) ll));_取 ll 的第一个表依次求前一段的两个参数 
       (setq ll (list (list (- end _len) end)));_第一次 将尾端的两个数 构造表 
     ) 
   ) 
   (setq ll (cons (list start (+ start _len)) ll));_这里首段单独加，用减法 start 可能出现极小值 
 ) 
      ) 
    ) 
    (progn;_没有间隙的情况下直接分段 
      (setq _len (/ len num)) 
      (repeat (1+ (fix num)) 
 (if ll 
   (setq ll (cons (- (car ll) _len) ll));_ll已有的时候依次构造前一参数 
   (setq ll (list end));_由尾端开始，省 reverse 
 ) 
      ) 
    ) 
  ) 
  ll 
)

账号		自动登录	找回密码
密码			立即注册

[求助] 关于vlax-curve-getPointAtDist捕捉点问题

点评

评分

点评

点评

点评

评分

点评

点评

点评

点评

点评