找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2331|回复: 3

[求助] SPline 转 pline 源代码!有点小问题。

[复制链接]
发表于 2015-4-28 19:32:30 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
在三维实体被面域切割,会得到一条相贯线,(REGION)  
炸开后变为了小段的spline。 把SPlin 变为Pline 或 line,才方便倒腾到**软件,
千辛万苦才找到了一个源代码。可执行,但,SPlin转成Pline后,第一点是正确的,尾点却跑歪了。
想请高手看看,帮忙修改一下!
(defun spline-to-pline (/ i)
  (vl-load-com)
  (setq        *thisdrawing* (vla-get-activedocument
                        (vlax-get-acad-object)
                      ) ;_ end of vla-get-activedocument
        *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  ) ;_ end of setq
  (setq spline-list (get-spline))
  (setq i (- 1))
  (if spline-list
    (progn
      (setq msg "\nN鷐ero de segmentos <100>: ")
      (initget 6)
      (setq num (getint msg))
      (if (or (= num 100) (= num nil))
        (setq num 100)
      ) ;_ end of if
      (repeat (length spline-list)
        (setq splobj (nth (setq i (1+ i)) spline-list))
        (convert-spline splobj num)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of spline-to-pline

(defun get-spline (/ spl-list obj spline no-ent i)
  (setq        spl-list nil
        obj         nil
        spline         "AcDbSpline"
        selsets         (vla-get-selectionsets *thisdrawing*)
        ss1         (vlax-make-variant "ss1")
  ) ;_ end of setq
  (if (= (vla-get-count selsets) 0)
    (setq ssobj (vla-add selsets ss1))
  ) ;_ end of if
  (vla-clear ssobj)
  (setq no-ent 1)
  (while no-ent
    (prompt "\nSeleccione splines: ")
    (vla-Selectonscreen ssobj)
    (if        (> (vla-get-count ssobj) 0)
      (progn
        (setq no-ent nil)
        (setq i (- 1))
        (repeat        (vla-get-count ssobj)
          (setq
            obj        (vla-item ssobj
                          (vlax-make-variant (setq i (1+ i)))
                ) ;_ end of vla-item
          ) ;_ end of setq
          (cond
            ((= (vlax-get-property obj "ObjectName") spline)
             (setq spl-list
                    (append spl-list (list obj))
             ) ;_ end of setq
            )
          ) ;_ end-of cond
        ) ;_ end of repeat
      ) ;_ end of progn
      (prompt "\nNo hay entidades seleccionadas. Int閚talo de nuevo.")
    ) ;_ end of if
    (if        (and (= nil no-ent) (= nil spl-list))
      (progn
        (setq no-ent 1)
        (prompt "\nNo hay splines seleccionadas.")
        (quit)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while  
  (vla-delete (vla-item selsets 0))
  spl-list
) ;_ end of get-spline

(defun convert-spline (splobj n / i)
  (setq        point-list   nil
        2Dpoint-list nil
        z-list             nil
        spl-lyr             (vlax-get-property splobj 'Layer)
        startSpline  (vlax-curve-getStartParam splobj)
        endSpline    (vlax-curve-getEndParam splobj)
        i             (- 1)
  ) ;_ end of setq
  (repeat (+ n 1)
    (setq i (1+ i))
    (setq p (vlax-curve-getPointAtParam
              splobj
              (* i
                 (/ (- endspline startspline) n)
              ) ;_ end of *
            ) ;_ end of vlax-curve-getPointAtParam
    ) ;_ end of setq
    (setq 2Dp               (list (car p) (cadr p))
          2Dpoint-list (append 2Dpoint-list 2Dp)
          point-list   (append point-list p)
          z               (caddr p)
          z-list       (append z-list (list z))
    ) ;_ end of setq
  ) ;_ end of repeat
  (setq summ (apply '+ z-list))
  (setq        arraySpace
         (vlax-make-safearray
           vlax-vbdouble ; element type
           (cons 0
                 (- (length point-list) 1)
           ) ; array dimension
         ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq vert-array (vlax-safearray-fill arraySpace point-list))
  (vlax-make-variant vert-array)
  (if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar))
           (= summ 0.0)
      ) ;_ end of and
    (setq plobj        (add-polyline
                  2Dpoint-list
                  vla-AddLightweightPolyline
                ) ;_ end of add-polyline
    ) ;_ end of setq
    (setq plobj        (add-polyline
                  point-list
                  vla-Add3DPoly
                ) ;_ end of add-polyline
    ) ;_ end of setq
  ) ;_ end of if
  (vlax-put-property plobj 'Layer spl-lyr)
  (vla-delete splobj)
  (vlax-release-object splobj)
) ;_ end of convert-spline

(defun add-polyline (pt-list poly-func)
  (setq        arraySpace
         (vlax-make-safearray
           vlax-vbdouble
           (cons 0
                 (- (length pt-list) 1)
           ) ; array dimension
         ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq        vertex-array
         (vlax-safearray-fill arraySpace pt-list)
  ) ;_ end of setq
  (vlax-make-variant vertex-array)
  (setq        plobj (poly-func
                *modelspace*
                vertex-array
              ) ;_ end of poly-func
  ) ;_ end of setq
) ;_ end of add-polyline

(defun c:s2p ()
  (spline-to-pline)
  (princ)
) ;_ end of c:s2p

(prompt
  "SPLINE-TO-PLINE by Tony Hotchkiss. Entrar S2P para iniciar"
) ;_ end of prompt



论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2015-4-28 19:42:56 | 显示全部楼层
补 充 说 明!
楼上的源代码,在世界坐标系下验证,它的执行结果是正确的!
但在ucs下,起点位置正确,线也是那么回事,但尾巴翘别的位置去了!:(
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 475个

财富等级: 日进斗金

发表于 2015-5-25 19:46:58 | 显示全部楼层
加句
(command "_.ucs" "w")
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

xqgk1sIb 该用户已被删除
发表于 2015-10-20 20:52:55 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-4-25 16:55 , Processed in 0.357897 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表