请指点一下,可以取得多段线粗线的部分在线上的位置长度吗?

ww5w

cable2004 发表于 2013-2-1 20:30

能提供源码学习一下吗

yjr111

ww5w

yjr111 发表于 2013-2-2 09:25

谢谢,非常好,效果不错,
不过有时想改一下矩形的高度和离线的距离,却改不了,成固定了.
如果能改就好了.
可以指点一下怎么展线吗?线宽也不变.

xiabin68

ww5w 发表于 2013-2-1 12:35
如果可以,展开后的线有线宽还是能显示有线宽,谢谢.

以下代码已经加入展直与写长度在那个方框里去


;取lwpoline线变宽的地方，并在上生成方框
;    xiabin68  
;    QQ:19539078
; 以下程序没有加入任何子函数希望对初学有帮助
;转载请说明出处与作者信息
(defun c:hk nil
  (setq ent (car (entsel"请选择多段线:")));选择多段线
  (setq zb (getpoint "请选择多段线展直起点:"));选择新建多段线的起点
  (setq lst (entget ent));取DXF表
  (setq dd (length lst));取表的数量
  (setq zblst '());建空表
  (setq i 0)
   (while (/= (car (nth i lst)) 10);判断每一个坐标在元素的位置
     (setq i (1+ i))
     )

(setq zblst (append zblst (list (cons 10 zb)) (list (nth (+ 1 i) lst)) (list (nth (+ 2 i) lst)) (list (nth (+ 3 i) lst))));把第一个位置加入到zblst表中去
   
  (while (= 10 (car (nth i lst))) ;重复取坐标并建表
        (setq x1 (cdr (nth i lst)));取第一个坐标
        (if (= (car (nth (+ i 4) lst)) 10);再取出下一个坐标
            (setq x2 (cdr (nth (+ i 4) lst)))
            (setq x2 nil)
          )                                 
    (if (and x1 x2)  ;如果下一个坐标不为NIL就继续运行
      (progn
        (setq dist (distance x1 x2));算出两点的直线距离
        (setq x3 (polar zb (angtof "0") dist));再以起点为原点算出下个点的新坐标
        (setq zblst (append zblst (list (cons 10 x3)) (list (nth (+ 5 i) lst)) (list (nth (+ 6 i) lst)) (list (nth (+ 7 i) lst))));再把后面的线宽一起取出加到表中去
        (setq  zb x3)
        (setq i (+ i 4))
        )
    (setq i 2)
      )
    );重复取坐标结束

  (setq zblst (append (list (assoc 0 lst) '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (assoc 90 lst)) zblst));建立多段线要素全部合并到一个表中
   (entmakex zblst);新建一个展直的多段线
  (setq aa (entlast));找到刚刚新建的多段线
  (setq lstt (entget aa))
  (setq n 0)
  (repeat (length lstt)
    (setq nn (car (nth n lstt)))
    (if (= nn 10);查看该元素是不是坐标元素
      (progn
        (setq xy (cdr (nth n lstt)));取出第一个点的坐标
        (setq high (cdr (nth (1+ n) lstt)));取出坐标后的线宽度是不是发升的变化
        (if (and xy (> high 0));是不是满足两个要求，要坐标 点，并后面的线席发生变化
          (progn
            (setq xx (cdr (nth (+ n 4) lstt)));取出下一个点的坐标
            (setq xy1 (polar  xy (angtof "90") 5));算矩形框 左下角点
            (setq xy2 (polar xx (angtof "90") 10));算矩形框 右上角点
            (setq textxy (polar xy1 (angle xy1 xy2) (/ (distance xy1 xy2) 3)));算出文字的坐标
            (setq lr (rtos (distance xy xx) 2 2));算出两点之间的长度
            (command "rectang" xy1 xy2);画矩形框
            (entmakex (list '(0 . "TEXT")  ;用文字写出长度
                              (cons 1 lr)
                             (cons 10 textxy)
                            (CONS 40 1.5)
            )
          )
        )
      )
        )
      )
    (setq n (1+ n))
    )
  )

(princ "程序加载成功输入HK运行!");加载成功 提示
          
       
       
   
          
         

ww5w

xiabin68 发表于 2013-2-2 14:00
以下代码已经加入展直与写长度在那个方框里去

这是图,箭头指的地方,是弧位,展开后还是弧..

xiabin68

ww5w 发表于 2013-2-2 14:57
这是图,箭头指的地方,是弧位,展开后还是弧..

都没有发现这个问题，，呵呵，，我看看，，，

xiabin68

ww5w 发表于 2013-2-2 14:57
这是图,箭头指的地方,是弧位,展开后还是弧..

这下把程序优华了一下，效果见上图

ww5w

谢谢xiabin68,效果非常好,还多了一个标上尺寸功能,又注释,学习了.辛苦你了!

xiabin68

ww5w 发表于 2013-2-2 21:54
谢谢xiabin68,效果非常好,还多了一个标上尺寸功能,又注释,学习了.辛苦你了!

慢慢学吧，这个程序可以变的很精间的，，方便大家学习，没有用自定义函数，，，你试着改吧，，，

yjr111

xiabin68 发表于 2013-2-2 22:28
慢慢学吧，这个程序可以变的很精间的，，方便大家学习，没有用自定义函数，，，你试着改吧，，，

附上源码：

2. (defun get_pline-vertexs (e / i v lst)
   
3.   (setq i -1)
   
4.   (while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   
5.     (setq lst (cons v lst))
   
6.   )
   
7.   (reverse lst)
   
8. )
   
9. (defun makelwpline(lst)
   
10.   (entmake (append (list '(0 . "LWPOLYLINE")
    
11.                          '(100 . "AcDbEntity")
    
12.                          '(100 . "AcDbPolyline")
    
13.                          (cons 90 (length lst))
    
14.                     )
    
15.                     (mapcar '(lambda (pt) (cons 10 pt)) lst)
    
16.             )
    
17.    )
    
18. )
    
19. (defun drawagain(lst / p1 p2 )
    
20. (if(cadr lst)
    
21.   (progn
    
22.    (vla-GetWidth obj n 'sw 'ew)
    
23.    (setq p1(car lst)p2(cadr lst))
    
24.    (if(not(=(setq sw(eval 'sw))(setq ew(eval 'ew))0.0))      
    
25.     (setq reclst(cons(list p1 p2)reclst) widindex(cons (list n sw ew) widindex))
    
26.    )
    
27.   (setq n(1+ n))
    
28.   (if(cadr lst)(drawagain(cdr lst)))
    
29.   )
    
30. )
    
31. )
    
32. (defun makenewlst(lst / px py dislst)
    
33.   (setq px (caar lst) py (cadar lst))
    
34.   (mapcar '(lambda(x)(setq dislst(cons(vlax-curve-getDistAtPoint obj x)dislst)))lst)
    
35.   (mapcar '(lambda(x)(setq newplst(cons (list (+ x px)py)newplst)))(reverse dislst))
    
36.   (setq newplst (reverse newplst))  
    
37. )
    
38. (defun c:tt(/ obj plst n inp newplst reclst widindex oldosm oldcol)
    
39. (command "ucs" "w")
    
40. (setq obj(vlax-ename->vla-object (car(entsel"\n选择多段线"))))
    
41.   (if obj
    
42.     (progn
    
43.       (setq plst(get_pline-vertexs obj) n 0 inp(getpoint"\n展直插入点"))
    
44.       (makenewlst plst)
    
45.       (makelwpline newplst)
    
46.       (drawagain newplst)      
    
47.       (setq obj(vlax-ename->vla-object(entlast)))
    
48.       (vla-move obj (vlax-3d-point(car plst))(vlax-3d-point inp))
    
49.       (mapcar '(lambda(x)(apply 'vla-setwidth (cons obj x))) (reverse widindex))
    
50.       (setq oldosm (getvar 'osmode))
    
51.       (setq oldcol (getvar 'cecolor))
    
52.       (setvar 'osmode 0)
    
53.       (setvar 'cecolor "2")
    
54.       (foreach x reclst
    
55.         (command "rectang" (list(caar x)(+ 5(cadar x)))(list(caadr x)(+ 10(cadadr x))))
    
56.         (vla-move (vlax-ename->vla-object(entlast)) (vlax-3d-point(car plst))(vlax-3d-point inp))
    
57.         )
    
58.       )
    
59.   )
    
60. (setvar 'osmode oldosm)
    
61. (setvar 'cecolor oldcol)
    
62. (command "ucs" "p")
    
63. (princ)
    
64. )
    
65.       
    
66.       
    

(defun get_pline-vertexs (e / i v lst)<br />   (setq i -1)<br />   (while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />     (setq lst (cons v lst))<br />   )<br />   (reverse lst)<br /> )<br /> (defun makelwpline(lst)<br />   (entmake (append (list '(0 . "LWPOLYLINE")<br />                          '(100 . "AcDbEntity")<br />                          '(100 . "AcDbPolyline")<br />                          (cons 90 (length lst))<br />                     )<br />                     (mapcar '(lambda (pt) (cons 10 pt)) lst)<br />             )<br />    )<br /> )<br /> (defun drawagain(lst / p1 p2 )<br /> (if(cadr lst)<br />   (progn<br />    (vla-GetWidth obj n 'sw 'ew)<br />    (setq p1(car lst)p2(cadr lst))<br />    (if(not(=(setq sw(eval 'sw))(setq ew(eval 'ew))0.0))      <br />     (setq reclst(cons(list p1 p2)reclst) widindex(cons (list n sw ew) widindex))<br />    )<br />   (setq n(1+ n))<br />   (if(cadr lst)(drawagain(cdr lst))) <br />   )<br /> )<br /> )<br /> (defun makenewlst(lst / px py dislst)<br />   (setq px (caar lst) py (cadar lst))<br />   (mapcar '(lambda(x)(setq dislst(cons(vlax-curve-getDistAtPoint obj x)dislst)))lst)<br />   (mapcar '(lambda(x)(setq newplst(cons (list (+ x px)py)newplst)))(reverse dislst))<br />   (setq newplst (reverse newplst))  <br /> )<br /> (defun c:tt(/ obj plst n inp newplst reclst widindex oldosm oldcol)<br /> (command "ucs" "w")<br /> (setq obj(vlax-ename->vla-object (car(entsel"\n选择多段线"))))<br />   (if obj<br />     (progn<br />       (setq plst(get_pline-vertexs obj) n 0 inp(getpoint"\n展直插入点"))<br />       (makenewlst plst)<br />       (makelwpline newplst)<br />       (drawagain newplst)      <br />       (setq obj(vlax-ename->vla-object(entlast)))<br />       (vla-move obj (vlax-3d-point(car plst))(vlax-3d-point inp))<br />       (mapcar '(lambda(x)(apply 'vla-setwidth (cons obj x))) (reverse widindex))<br />       (setq oldosm (getvar 'osmode))<br />       (setq oldcol (getvar 'cecolor))<br />       (setvar 'osmode 0)<br />       (setvar 'cecolor "2")<br />       (foreach x reclst<br />         (command "rectang" (list(caar x)(+ 5(cadar x)))(list(caadr x)(+ 10(cadadr x))))<br />         (vla-move (vlax-ename->vla-object(entlast)) (vlax-3d-point(car plst))(vlax-3d-point inp))<br />         )<br />       )<br />   )<br /> (setvar 'osmode oldosm)<br /> (setvar 'cecolor oldcol)<br /> (command "ucs" "p")<br /> (princ)<br /> )<br />       <br />       <br />