线变矩形加强,线变墙体.

鱼与熊掌

更新。2014-11.9
重构代码。重新写了一遍。
静默退出。等。自己体会。


支持直线,多段线变成墙体类矩形,方便填充,参照图片.
更新`.` 6.21 完全支持

代码有点乱,不过能工作就好了-.-

00放飞梦想00

楼主第一个代码PL可以转墙体，第二个代码线段和多线段都可以转，第二个功能强大，没明白还想什么功能，望楼主回复，

qazxswk

功能单一了点，如果是墙体，那T型墙体，井字型墙体没有考虑

电赛加油

  多谢大神分享，学习一下！

xiaobaixiaobu

这个应该可以吧！

鱼与熊掌

xiaobaixiaobu 发表于 2014-6-17 17:28
这个应该可以吧！

我需要方向,然后需要他是多短线 那么我就可以快速填充

edata

你表达得有点模糊，目前我没弄懂你要做什么。。。

1. (defun qdd(ss)
   
2. (setq a 1)
   
3. (if (not **W**) (setq **W** 1.00))
   
4.   (setq **W** (cond((getdist(strcat "\n输入宽度 <"(rtos **W** 2 2) ">: ")))(**W**)))
   
5. ;(setq ss (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))
   
6. (setq
   
7. ex (ssname ss 0)
   
8. ss1 ss
   
9. )
   
10. ;获取端点列表1
    
11. (setq lst (mapcar 'cdr
    
12.           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (setq a (entget ex))
    
13. )
    
14. )
    
15. )
    
16. (command "offset" **w** ss pause "")
    
17. ;获取偏移线点表
    
18. (command "ERASE" ss1 "" )
    
19. (setq cm (getvar "cmdecho"))
    
20. (setvar "cmdecho" 0)
    
21. (setq lst2 (mapcar 'cdr
    
22.           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (setq a (entget (entlast)))
    
23. )
    
24. )
    
25. )
    
26. (command "ERASE" (entlast) "")
    
27. 
    
28. (setq lst2 (cons  (nth 0 lst) lst2))
    
29. (setq lst1x(reverse lst2))
    
30. 
    
31. (setq lscx (append lst lst1x))
    
32. ;(setq lscx (list lscx (nth 0 lst)))
    
33.   (entmake (append (list '(0 . "LWPOLYLINE")
    
34.                          '(100 . "AcDbEntity")
    
35.                          '(100 . "AcDbPolyline")
    
36.                          (cons 90 (length lscx))
    
37.                    )
    
38.                    (mapcar '(lambda (pt) (cons 10 pt)) lscx)
    
39.            )
    
40.   )
    
41. (setvar "cmdecho" cm)
    
42. 
    
43. (princ "CX-矩形增强版")
    
44. )
    
45. 
    
46. (defun c:te1()
    
47. (setq cm (getvar "cmdecho"))
    
48. (setvar "cmdecho" 0)
    
49. (setvar "peditaccept" 1) ;加入这个系统变量的代码
    
50. (if  (setq KX (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))
    
51. (command "_pedit" "m" KX "" "j" "10" ""))
    
52. (command "change" (entlast) "" "p" "co" "1" "")  
    
53.   (qdd (ssadd (entlast)))
    
54. (setvar "cmdecho" cm)
    
55. (princ))

(defun qdd(ss)<br /> (setq a 1)<br /> (if (not **W**) (setq **W** 1.00))<br />   (setq **W** (cond((getdist(strcat "\n输入宽度 <"(rtos **W** 2 2) ">: ")))(**W**))) <br /> ;(setq ss (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))<br /> (setq<br /> ex (ssname ss 0)<br /> ss1 ss<br /> )<br /> ;获取端点列表1<br /> (setq lst (mapcar 'cdr<br />           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (setq a (entget ex))<br /> )<br /> )<br /> )<br /> (command "offset" **w** ss pause "")<br /> ;获取偏移线点表<br /> (command "ERASE" ss1 "" )<br /> (setq cm (getvar "cmdecho"))<br /> (setvar "cmdecho" 0)<br /> (setq lst2 (mapcar 'cdr<br />           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (setq a (entget (entlast)))<br /> )<br /> )<br /> )<br /> (command "ERASE" (entlast) "")<br /> <br /> (setq lst2 (cons  (nth 0 lst) lst2))<br /> (setq lst1x(reverse lst2))<br /> <br /> (setq lscx (append lst lst1x))<br /> ;(setq lscx (list lscx (nth 0 lst)))<br />   (entmake (append (list '(0 . "LWPOLYLINE")<br />                          '(100 . "AcDbEntity")<br />                          '(100 . "AcDbPolyline")<br />                          (cons 90 (length lscx))<br />                    )<br />                    (mapcar '(lambda (pt) (cons 10 pt)) lscx)<br />            )<br />   )<br /> (setvar "cmdecho" cm)<br /> <br /> (princ "CX-矩形增强版")<br /> )<br /> <br /> (defun c:te1()<br /> (setq cm (getvar "cmdecho"))<br /> (setvar "cmdecho" 0)<br /> (setvar "peditaccept" 1) ;加入这个系统变量的代码<br /> (if  (setq KX (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))<br /> (command "_pedit" "m" KX "" "j" "10" ""))<br /> (command "change" (entlast) "" "p" "co" "1" "")  <br />   (qdd (ssadd (entlast)))<br /> (setvar "cmdecho" cm)<br /> (princ))

鱼与熊掌

edata 发表于 2014-6-17 18:22
你表达得有点模糊，目前我没弄懂你要做什么。。。

        我这个代码已经实现了 直线变成矩形,和多短线变成矩形的功能.
    利用的就是把偏移线的点表提取出来,然后重新生成多段线,这样就可以方便填充了.
       现在还没完善的是  如果选多条连在一起的线 ,那么我要把他先变成多段线,然后在偏移出来.  
  代码没什么难度,我自己写写就好了`.`

hooboxu

真不错明天来下，感谢

hooboxu

程度很不错，但每次结束都有这个消息出来

选择对象:  未知命令“QDD”。按 F1 查看帮助。
未知命令“QDD”。按 F1 查看帮助。

hooboxu

未知命令“QDD”。按 F1 查看帮助。
CX-矩形增强版"CX-矩形增强版"

鱼与熊掌

hooboxu 发表于 2014-11-6 23:48
程度很不错，但每次结束都有这个消息出来

选择对象:  未知命令“QDD”。按 F1 查看帮助。

  有空修复一下。

鱼与熊掌

hooboxu 发表于 2014-11-6 23:48
程度很不错，但每次结束都有这个消息出来

选择对象:  未知命令“QDD”。按 F1 查看帮助。

已经更新了一下。