线变矩形加强,线变墙体._CAD中文技术交流网

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

本帖最后由鱼与熊掌于 2014-12-8 13:39 编辑

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

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

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

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

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

网友答: 多谢大神分享，学习一下！

网友答: 这个应该可以吧！

网友答:

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

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

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

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

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

网友答:

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

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

网友答: 真不错明天来下，感谢

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

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

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

网友答:

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

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

有空修复一下。

网友答:

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

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

已经更新了一下。

上一篇：新人求助！没有按预想的位置绘制图形

下一篇：没有了