请帮忙写一个将多段线局部加粗的工具

Lisphk

今天处理个图，需要把多段线的局部段加粗，能不能写个代码能快点呢？ 比如拾取多段线的两个顶点，顶点间的线段就按照指定的宽度加粗。谢谢！

csharp

好像在每日插件见过

newer

简单写了一个，WCS，UCS都测试了，见演示，请下载最新的API和通用LISP函数库。用了老大的API和通用LISP函数，代码很短

1. (defun c:tt ()
   
2.   (if (not #XDTB_GLOBAL_VAR_JVBUJIACHU)
   
3.      (setq #XDTB_GLOBAL_VAR_JVBUJIACHU 2.0)
   
4.   )
   
5.   (if (setq jc (getreal (xdrx_prompt "\n请输入局部加粗的宽度<" #XDTB_GLOBAL_VAR_JVBUJIACHU ">:" t)))
   
6.      (setq #XDTB_GLOBAL_VAR_JVBUJIACHU jc)
   
7.   )
   
8.   (if (and
   
9.         (setq e1 (xdrx_entsel "\n请在起始段附近拾取点<退出>:" '((0 . "*POLYLINE"))))
   
10.         (setq p1 (trans (cadr e1) 1 0))
    
11.         (setq inx1 (XD::Polyline:NearIndex (car e1) p1))
    
12.         (xd::doc:drawcrosshair (xdrx_polyline_getpointat (car e1) inx1))
    
13.         (setq e2 (xdrx_entsel "\n请在结束附近拾取点<退出>:" '((0 . "*POLYLINE"))))
    
14.         (setq p2(trans (cadr e2) 1 0))
    
15.         (setq inx2 (XD::Polyline:NearIndex (car e2) p2))
    
16.         (setq inx2 (if (= inx1 inx2)(1+ inx1) inx2))
    
17.         (xd::doc:drawcrosshair (xdrx_polyline_getpointat (car e2) inx2))
    
18.         (setq e3 (xdrx_entsel "\n请拾取下两点的中间段<退出>:" '((0 . "*POLYLINE"))))
    
19.         (setq p3 (trans (cadr e3) 1 0))
    
20.         (equal (car e1) (car e2))
    
21.         (equal (car e1) (car e3))
    
22.       )
    
23.     (progn
    
24.       (setq inx12 (XD::Polyline:NearIndex (car e3) p3)
    
25.             inx12 (if (and (= 1 (- inx2 inx1))(= inx12 inx2)) (1- inx12) inx12)
    
26.             pnts (XD::Polyline:MidPntAtIndexs (car e1) inx1 inx2 inx12)
    
27.             inxs (mapcar
    
28.                    '(lambda (x)
    
29.                       (XD::Polyline:NearIndex (car e1) x)
    
30.                     )
    
31.                    pnts
    
32.                  )
    
33.             dotpair (XD::List:SnakePair inxs)
    
34.       )
    
35.       (mapcar
    
36.         '(lambda (x)
    
37.            (xdrx_polyline_setWidthsAt (car e1) x #XDTB_GLOBAL_VAR_JVBUJIACHU #XDTB_GLOBAL_VAR_JVBUJIACHU)
    
38.          )
    
39.         (XD::List:RemoveTail inxs)
    
40.       )
    
41.     )
    
42.   )
    
43.   (if (not e3)
    
44.      (princ "\n没有拾取到中间段，退出!")
    
45.   )
    
46.   (princ)
    
47. )
    
48. 
    

(defun c:tt ()<br />   (if (not #XDTB_GLOBAL_VAR_JVBUJIACHU)<br />      (setq #XDTB_GLOBAL_VAR_JVBUJIACHU 2.0)<br />   )<br />   (if (setq jc (getreal (xdrx_prompt "\n请输入局部加粗的宽度<" #XDTB_GLOBAL_VAR_JVBUJIACHU ">:" t)))<br />      (setq #XDTB_GLOBAL_VAR_JVBUJIACHU jc)<br />   )<br />   (if (and<br />         (setq e1 (xdrx_entsel "\n请在起始段附近拾取点<退出>:" '((0 . "*POLYLINE"))))<br />         (setq p1 (trans (cadr e1) 1 0))<br />         (setq inx1 (XD::Polyline:NearIndex (car e1) p1))<br />         (xd::doc:drawcrosshair (xdrx_polyline_getpointat (car e1) inx1))<br />         (setq e2 (xdrx_entsel "\n请在结束附近拾取点<退出>:" '((0 . "*POLYLINE"))))<br />         (setq p2(trans (cadr e2) 1 0))<br />         (setq inx2 (XD::Polyline:NearIndex (car e2) p2))<br />         (setq inx2 (if (= inx1 inx2)(1+ inx1) inx2))<br />         (xd::doc:drawcrosshair (xdrx_polyline_getpointat (car e2) inx2))<br />         (setq e3 (xdrx_entsel "\n请拾取下两点的中间段<退出>:" '((0 . "*POLYLINE"))))<br />         (setq p3 (trans (cadr e3) 1 0))<br />         (equal (car e1) (car e2))<br />         (equal (car e1) (car e3))<br />       )<br />     (progn<br />       (setq inx12 (XD::Polyline:NearIndex (car e3) p3)<br />             inx12 (if (and (= 1 (- inx2 inx1))(= inx12 inx2)) (1- inx12) inx12)<br />             pnts (XD::Polyline:MidPntAtIndexs (car e1) inx1 inx2 inx12)<br />             inxs (mapcar<br />                    '(lambda (x)<br />                       (XD::Polyline:NearIndex (car e1) x)<br />                     )<br />                    pnts<br />                  )<br />             dotpair (XD::List:SnakePair inxs)<br />       )<br />       (mapcar<br />         '(lambda (x)<br />            (xdrx_polyline_setWidthsAt (car e1) x #XDTB_GLOBAL_VAR_JVBUJIACHU #XDTB_GLOBAL_VAR_JVBUJIACHU)<br />          )<br />         (XD::List:RemoveTail inxs)<br />       )<br />     )<br />   )<br />   (if (not e3)<br />      (princ "\n没有拾取到中间段，退出!")<br />   )<br />   (princ)<br /> )<br /> <br />

Lisphk

哇，试了代码，太完美了，谢谢N版，这有个帖子帮看看， http://bbs.xdcad.net/thread-704033-1-1.html