（完成）[编程申请]：延伸多义线局部线段

coolzhb · 发表于 2003-9-9 15:52:33

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

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

×

窗选交点，在窗选范围内的交点向外延伸一个长度，原来的线可能是一根多义线，也可能是多根多义线！
看运行效果图！

eachy · 发表于 2003-9-9 18:55:51

最初由 coolzhb 发布
[B]窗选交点，在窗选范围内的交点向外延伸一个长度，原来的线可能是一根多义线，也可能是多根多义线！
看运行效果图！ [/B]

只需要多义线，不会有line ？延伸的长度是输入还是一个定值？
多义线中有圆弧吗？

已添加至即时更新专贴

coolzhb · 发表于 2003-9-9 20:12:01

eachy,我用了，但是没有能达到我的要求，在框选中的交点延长，而不是所有的都延长，如果能兼容line线最好了，要求如果是line，则先变成pline线，再执行同样的操作！
圆弧的就不要了，一般碰不到这种情况！谢谢！请eachy再修改一下！

lsjjm · 发表于 2003-9-10 08:10:42

延伸后还是多义线吗？

coolzhb · 发表于 2003-9-10 11:51:49

最初由 lsjjm 发布
[B]延伸后还是多义线吗？ [/B]

对，延伸后还是多义线！
具体用于结构配筋图中，钢筋的延伸！
请eachy兄和各位大侠帮忙呀。。。对我很有用！

liweinc · 发表于 2003-9-12 16:09:16

这是画配筋图的一个问题，我一直是用LEN-DE做的

coolzhb · 发表于 2003-9-12 16:28:07

最初由 liweinc 发布
[B]这是画配筋图的一个问题，我一直是用LEN-DE做的 [/B]

LEN-DE是什么？能发上来共享吗？

liweinc · 发表于 2003-9-12 16:50:27

最初由 coolzhb 发布
[B]

LEN-DE是什么？能发上来共享吗？ [/B]

我是指“拉长”命令lengthen，选择“增量(DE)”方式，可以将直线增加一个指定长度（多一线要先炸成直线）。

lsjjm · 发表于 2003-9-12 20:48:42

请问8楼: 炸开延伸后如何再变成多义线?

eachy · 发表于 2003-9-12 21:02:38

最初由 lsjjm 发布
[B]请问8楼: 炸开延伸后如何再变成多义线? [/B]

炸开之前

(xdrx_setmark)

复制代码

延伸之后用

(command ".pedit" "m" (xdrx_getss) "" "Y" "j" "0.001" "")

工具箱中的【多线延伸】用的是重新生成的方法。

lsjjm · 发表于 2003-9-13 05:43:05

(xdrx_setmark)?
(xdrx_getss)?
是工具箱的函数吧? 可我公司不许下载, 能否展示一下函数的程序码?

eachy · 发表于 2003-9-13 08:58:56

最初由 lsjjm 发布
[B](xdrx_setmark)?
(xdrx_getss)?
是工具箱的函数吧? 可我公司不许下载, 能否展示一下函数的程序码? [/B]

真遗憾，不能下载，如果你需要我可以给你发过去。
上面说的两个函数是 Xdrx_api 中的函数，如果是方便自己用，XDRX_API + VLisp 写程序是再顺手不过的了，Vl 中对实体要进行转换，api 则不用，而且api 的速度也比 VL 快。
下面是多线延伸到代码，我加了些注释，如果把其中的 API 函数用Lisp 代码来改写，程序将变大很多。
如果你替换好了一并发上来大家探讨下，谢谢。

($xdrx_load "xdlsp.lsp");;判断xdlsp.lsp是否加载，否，加载；是，不加
;;延伸多义线局部线段
(defun c:XDTB_PlineEXT (/ $ea_ptinbox $ea_list1
$ea_list2 ss dis pts e
ptl pw ptl1 ptl0 tf nt
pl ss1 b p1 p2
)
;;判断点是否在一个Box内
(defun $ea_ptinbox (p0 pt1 pt2)
(and
(and (> (car p0) (min (car pt1) (car pt2)))
(< (car p0) (max (car pt1) (car pt2)))
)
(and (> (cadr p0) (min (cadr pt1) (cadr pt2)))
(< (cadr p0) (max (cadr pt1) (cadr pt2)))
)
)
)
;;获取表内指定位置之间的原子
(defun $ea_list1 (lst st ed / l)
(while (<= st ed)
(setq l (cons (nth st lst) l)
st (1+ st)
)
)
(reverse l)
)
;;获取表中指定位置以后的表
(defun $ea_list2 (lst n / l)
(repeat (- (length lst) n)
(setq b (nth n lst))
(setq l (cons b l))
(setq n (1+ n))
)
(reverse l)
)
(princ "\n选择要多义线或多义线顶点...")
(if (and (setq p1 (getpoint "\n第一角点: "))
(setq p2 (getcorner p1 "\n第二角点: "))
(setq ss (ssget "c" p1 p2 '((0 . "*polyline"))))
($xdlsp_pickset_redraw ss 3);;亮显选择集
(setq dis (getdist "\n延伸长度: "))
)
(progn
(xdrx_begin);;标记程序开始
(xdrx_sysvar_push "osmode" "plinewid");;保存系统变量
(setvar "osmode" 0)
;|;处理 Line
(setq ss1 (ssget "c" p1 p2 '((0 . "line"))))
(xdrx_setmark)
(vl-cmdf ".pline" "m" ss1 "" "y" "")
(setq ss (xdrx_PickSet_Union ss (xdrx_getss)))
|;
(xdrx_setsstodb ss 0);;选择集放进内部数据库
(while (setq e (xdrx_getentdata 0))
(if (not (xdrx_polyline_hasBulges e));;判断是否含有圆弧
(progn
(setq ptl ($XDLSP_PLine_Vertex e);;获取多义线的顶点表
pw (xdrx_polyline_getConstantWidth e);;获取多义线的全局宽度
ptl1 (mapcar '(lambda (x) ($ea_ptinbox x p1 p2)) ptl);;判断多义线的顶点是否在选择的Box内
ptl0 (apply;;重新构造一个表，在Box内的点变为延伸后的两点，中间以 T 分隔，最后变为一个
'append;;已 T 分隔的数段多义线的顶点表
(mapcar
'(lambda (x y / pos)
(if (= x T)
(progn
(setq pos (vl-position y ptl))
(cond
((= pos 0)
(list (polar y (angle y (car ptl)) dis)
)
)
((= pos (1- (length ptl)))
(list (polar
y
(angle (cadr (reverse ptl))
(last ptl)
)
dis
)
)
)
(t
(list
(polar y
(angle (nth (1- pos) ptl) y)
dis
)
T
(polar y
(angle (nth (1+ pos) ptl) y)
dis
)
)
)
)
)
(list y)
)
)
ptl1
ptl
)
)
)
(setq tf t)
(while tf
(setq nt (vl-position T ptl0))
(if nt
(setq pl ($ea_list1 ptl0 0 (1- nt)))
(progn
(setq pl ptl0)
(setq tf nil)
)
)
(setvar "plinewid" pw)
($xdlsp_draw_pline pl nil);;以点表绘制多义线
(if nt
(setq ptl0 ($ea_list2 ptl0 (1+ nt)))
)
(setq pl nil
nt nil
)
)
(xdrx_entity_delete e);;删除多义线
(mapcar 'set
'(ptl ptl0 ptl1)
'(nil nil nil)
)
)
)
)
(xdrx_sysvar_pop);;恢复系统变量
(xdrx_end);;程序结束
(princ)
)
)
(princ)
)

($xdrx_load "xdlsp.lsp");;判断xdlsp.lsp是否加载，否，加载；是，不加 
;;延伸多义线局部线段 
(defun c:XDTB_PlineEXT (/        $ea_ptinbox        $ea_list1 
                        $ea_list2        ss        dis        pts        e 
                        ptl        pw        ptl1        ptl0        tf        nt 
                        pl        ss1        b p1 p2 
                       ) 
  ;;判断点是否在一个Box内 
  (defun $ea_ptinbox (p0 pt1 pt2) 
    (and 
      (and (> (car p0) (min (car pt1) (car pt2))) 
           (< (car p0) (max (car pt1) (car pt2))) 
      ) 
      (and (> (cadr p0) (min (cadr pt1) (cadr pt2))) 
           (< (cadr p0) (max (cadr pt1) (cadr pt2))) 
      ) 
    ) 
  ) 
  ;;获取表内指定位置之间的原子 
  (defun $ea_list1 (lst st ed / l) 
    (while (<= st ed) 
      (setq l  (cons (nth st lst) l) 
            st (1+ st) 
      ) 
    ) 
    (reverse l) 
  ) 
  ;;获取表中指定位置以后的表 
  (defun $ea_list2 (lst n / l) 
    (repeat (- (length lst) n) 
      (setq b (nth n lst)) 
      (setq l (cons b l)) 
      (setq n (1+ n)) 
    ) 
    (reverse l) 
  ) 
  (princ "\n选择要多义线或多义线顶点...") 
  (if (and (setq p1 (getpoint "\n第一角点: ")) 
           (setq p2 (getcorner p1 "\n第二角点: ")) 
           (setq ss (ssget "c" p1 p2 '((0 . "*polyline")))) 
           ($xdlsp_pickset_redraw ss 3);;亮显选择集 
           (setq dis (getdist "\n延伸长度: ")) 
      ) 
    (progn 
      (xdrx_begin);;标记程序开始 
      (xdrx_sysvar_push "osmode" "plinewid");;保存系统变量 
      (setvar "osmode" 0) 
      ;|;处理 Line 
      (setq ss1 (ssget "c" p1 p2 '((0 . "line")))) 
      (xdrx_setmark) 
      (vl-cmdf ".pline" "m" ss1 "" "y" "") 
      (setq ss (xdrx_PickSet_Union ss (xdrx_getss))) 
      |; 
      (xdrx_setsstodb ss 0);;选择集放进内部数据库 
      (while (setq e (xdrx_getentdata 0)) 
        (if (not (xdrx_polyline_hasBulges e));;判断是否含有圆弧 
          (progn 
            (setq ptl  ($XDLSP_PLine_Vertex e);;获取多义线的顶点表 
                  pw   (xdrx_polyline_getConstantWidth e);;获取多义线的全局宽度 
                  ptl1 (mapcar '(lambda (x) ($ea_ptinbox x p1 p2)) ptl);;判断多义线的顶点是否在选择的Box内 
                  ptl0 (apply;;重新构造一个表，在Box内的点变为延伸后的两点，中间以 T 分隔，最后变为一个 
                         'append;;已 T 分隔的数段多义线的顶点表 
                         (mapcar 
                           '(lambda (x y / pos) 
                              (if (= x T) 
                                (progn 
                                  (setq pos (vl-position y ptl)) 
                                  (cond 
                                    ((= pos 0) 
                                     (list (polar y (angle y (car ptl)) dis) 
                                     ) 
                                    ) 
                                    ((= pos (1- (length ptl))) 
                                     (list (polar 
                                             y 
                                             (angle (cadr (reverse ptl)) 
                                                    (last ptl) 
                                             ) 
                                             dis 
                                           ) 
                                     ) 
                                    ) 
                                    (t 
                                     (list 
                                       (polar y 
                                              (angle (nth (1- pos) ptl) y) 
                                              dis 
                                       ) 
                                       T 
                                       (polar y 
                                              (angle (nth (1+ pos) ptl) y) 
                                              dis 
                                       ) 
                                     ) 
                                    ) 
                                  ) 
                                ) 
                                (list y) 
                              ) 
                            ) 
                           ptl1 
                           ptl 
                         ) 
                       ) 
            ) 
            (setq tf t) 
            (while tf 
              (setq nt (vl-position T ptl0)) 
              (if nt 
                (setq pl ($ea_list1 ptl0 0 (1- nt))) 
                (progn 
                  (setq pl ptl0) 
                  (setq tf nil) 
                ) 
              ) 
              (setvar "plinewid" pw) 
              ($xdlsp_draw_pline pl nil);;以点表绘制多义线 
 
              (if nt 
                (setq ptl0 ($ea_list2 ptl0 (1+ nt))) 
              ) 
              (setq pl nil 
                    nt nil 
              ) 
            ) 
            (xdrx_entity_delete e);;删除多义线 
            (mapcar 'set 
                    '(ptl ptl0 ptl1) 
                    '(nil nil nil) 
            ) 
          ) 
        ) 
      ) 
      (xdrx_sysvar_pop);;恢复系统变量 
      (xdrx_end);;程序结束 
      (princ) 
    ) 
  ) 
  (princ) 
)

lsjjm · 发表于 2003-9-13 10:45:35

谢谢, 太多的xdrx_函数, 只能"断章取义"了, 我琢磨琢磨再说.
延伸后再变成多义线, 那多义线在延伸点的 "顶点" 不就不是一个了? 有点不太明白, 有这样的多义线吗?

eachy · 发表于 2003-9-13 12:15:29

最初由 lsjjm 发布
[B]谢谢, 太多的xdrx_函数, 只能"断章取义"了, 我琢磨琢磨再说.
延伸后再变成多义线, 那多义线在延伸点的 "顶点" 不就不是一个了? 有点不太明白, 有这样的多义线吗? [/B]

程序中的 api 函数用 Lisp/Vlisp 替换的话要增加很多代码，当然了你用纯Lisp完成上面的程序也就体会到 XDRX_API 的妙处。

程序不是增加多义线的点，是将多义线分成了数个多义线实体。

陌生人 · 发表于 2003-9-18 23:27:37

要增加顶点也不难做到

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

（完成）[编程申请]：延伸多义线局部线段

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

相关帖子

Re: [编程申请]：延伸多义线

浏览过的版块