搞Net的请求各位兄弟帮忙一个LSP代码功能，选择一条封闭PL，提示里面有多少文字

Real_King

搞Net的请求各位兄弟帮忙一个LSP代码功能，选择一条封闭PL，提示里面有多少个单行文字，视口什么的都可以不考虑
谢谢

print1985

2. ;闭合PL内单行文字数
   
3. (defun c:bhplts (/ ent pst ss)
   
4.   (if (setq ent (car (entsel "\n选择闭合PL线")))
   
5.     (progn
   
6.       (sfdplxfw ent)
   
7.       (setq pst (get-pl-ptlst ent))
   
8.       (if (ssget "wp" pst)
   
9.         (if (setq ss (ssget "p"  '((0 . "TEXT"))))
   
10.            (sslength ss);返回值，供net调用
    
11.            0 ;返回值，供net调用
    
12.         )
    
13.         0 ;返回值，供net调用
    
14.       )
    
15.     )
    
16.   )
    
17. )
    
18. 
    
19. ;获取PL线所有顶点坐标
    
20. (defun get-pl-ptlst (plent / ptlst)
    
21.    (setq  ptlst (vl-remove-if '(lambda (x) (/= 10 (car x)))(entget plent)))
    
22.    (mapcar 'cdr ptlst)
    
23. )
    
24. 
    
25. ;;缩放屏幕到pl线范围-子程序
    
26. (defun sfdplxfw (e / l pmzb pst pt1 pt2 pt3 pt4 x x1 x2 xy y y1 y2)
    
27.   (setq pst (get-pl-ptlst e))
    
28.   (setq pmzb (qpmzb)                       ; 屏幕对角点坐标
    
29.         pt1 (car pmzb)
    
30.         pt2 (cadr pmzb)
    
31.   )
    
32.   (setq l 0
    
33.         x1 (car pt1)
    
34.         y1 (cadr pt1)
    
35.         x2 (car pt2)
    
36.         y2 (cadr pt2)
    
37.   )
    
38.   (repeat (length pst)
    
39.     (setq xy (nth l pst)
    
40.           x (car xy)
    
41.           y (cadr xy)
    
42.     )
    
43.     (cond
    
44.       ((< x x1)
    
45.         (setq x1 x)
    
46.       )
    
47.       ((< y y1)
    
48.         (setq y1 y)
    
49.       )
    
50.       ((> x x2)
    
51.         (setq x2 x)
    
52.       )
    
53.       ((> y y2)
    
54.         (setq y2 y)
    
55.       )
    
56.     )
    
57.     (setq l (1+ l))
    
58.   )
    
59.   (setq pt3 (list x1 y1)
    
60.         pt4 (list x2 y2)
    
61.   )
    
62.   (command "zoom" "w" pt3 pt4)               ; 缩放屏幕到pl线范围
    
63. )

;闭合PL内单行文字数<br /> (defun c:bhplts (/ ent pst ss)<br />   (if (setq ent (car (entsel "\n选择闭合PL线")))<br />     (progn<br />       (sfdplxfw ent)<br />       (setq pst (get-pl-ptlst ent))<br />       (if (ssget "wp" pst)<br />         (if (setq ss (ssget "p"  '((0 . "TEXT"))))<br />            (sslength ss);返回值，供net调用<br />            0 ;返回值，供net调用<br />         )<br />         0 ;返回值，供net调用<br />       )<br />     )<br />   )<br /> )<br /> <br /> ;获取PL线所有顶点坐标<br /> (defun get-pl-ptlst (plent / ptlst)<br />    (setq  ptlst (vl-remove-if '(lambda (x) (/= 10 (car x)))(entget plent)))<br />    (mapcar 'cdr ptlst)<br /> )<br /> <br /> ;;缩放屏幕到pl线范围-子程序<br /> (defun sfdplxfw (e / l pmzb pst pt1 pt2 pt3 pt4 x x1 x2 xy y y1 y2)<br />   (setq pst (get-pl-ptlst e))<br />   (setq pmzb (qpmzb)                       ; 屏幕对角点坐标<br />         pt1 (car pmzb)<br />         pt2 (cadr pmzb)<br />   )<br />   (setq l 0<br />         x1 (car pt1)<br />         y1 (cadr pt1)<br />         x2 (car pt2)<br />         y2 (cadr pt2)<br />   )<br />   (repeat (length pst)<br />     (setq xy (nth l pst)<br />           x (car xy)<br />           y (cadr xy)<br />     )<br />     (cond<br />       ((< x x1)<br />         (setq x1 x)<br />       )<br />       ((< y y1)<br />         (setq y1 y)<br />       )<br />       ((> x x2)<br />         (setq x2 x)<br />       )<br />       ((> y y2)<br />         (setq y2 y)<br />       )<br />     )<br />     (setq l (1+ l))<br />   )<br />   (setq pt3 (list x1 y1)<br />         pt4 (list x2 y2)<br />   )<br />   (command "zoom" "w" pt3 pt4)               ; 缩放屏幕到pl线范围<br /> )

随便改了下 试试

yoyoho

多谢分享

Real_King

print1985 发表于 2016-4-30 12:34
随便改了下 试试

多谢兄弟多谢兄弟