自动化窗线,怎么框选矩形可以自动加上窗线

ww5w

在xiabin68的帮助下,弄了可以自动化画矩形,但窗线怎么可以也自动化,框选矩形自动加上窗线!!
如下图,

注册

论坛有个画立面窗的有源码，我一直在用，感觉不错

999999

顶起来，，这个功能还是蛮好的，希望能够得到解决

xiabin68

这复制一下不就行了吗？？？

xiabin68

上图可以直接加在代码里

ww5w

xiabin68 发表于 2013-2-4 23:55
上图可以直接加在代码里

这图吗?

xiabin68

ww5w 发表于 2013-2-5 02:29
这图吗?

把你的代码帖出来，直接在你的里面改一下就行了，

ww5w

xiabin68 发表于 2013-2-5 10:15
把你的代码帖出来，直接在你的里面改一下就行了，

代码在下面,只是加了一些阵列,跟你写的差不多,麻烦你看看能否加上框内线,谢谢!

2. ;取lwpoline线变宽的地方，并在上生成方框
   
3. ;    xiabin68  
   
4. ;    QQ:19539078
   
5. ; 以下程序没有加入任何子函数希望对初学有帮助
   
6. ;转载请说明出处与作者信息
   
7. (defun c:hk ()
   
8. (setvar "cmdecho" 0)
   
9. (setq os (getvar "osmode"))
   
10.   (setq ent (car (entsel"\n请选择多段线:")))
    
11.   (setq vlent (vlax-ename->vla-object ent))
    
12. (setq entLEN (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
    
13.   (setq zb (getpoint "请选择展开起点:"))
    
14.   (setvar "osmode" 0)
    
15. (setq zb1 (list (+ 3 (car zb))(+ 1000 (cadr zb))));;;;;;;;;;;;设3偏右离起点距离;1000设距高
    
16. (setq zb3 (list (+ 3 (car zb))(cadr zb)))
    
17. (setq zb2 (list (+ entLEN (car zb1))(+ 1000 (cadr zb))))
    
18. (command "_pline" zb1 zb2 "")
    
19. (setq cenLine (entlast))
    
20. (command ".chprop" cenLine "" "p" "layer" "--008" "");;;;;设线归层
    
21. (command "_array" cenLine ""  "r" 5 "1" 1000 );;;;;;;;;;;;;;;;;;;;;设5阵列数量;1000设距高
    
22. (command "_.rectang" zb3 (strcat "@" (rtos entLEN 2) "," (rtos 5000 2)));;;;;;;;;;;;;总高度
    
23. (command ".chprop" (entlast) "" "p" "layer" "--006" "")
    
24.   (setq lst (entget ent))
    
25.   (setq dd (length lst))
    
26.   (setq zblst '())
    
27.   (setq i 0)
    
28.    (while (/= (car (nth i lst)) 10)
    
29.      (setq i (1+ i))
    
30.      )
    
31. (setq zblst (append zblst (list (cons 10 zb3)) (list (nth (+ 1 i) lst)) (list (nth (+ 2 i) lst))))
    
32.   (while (= 10 (car (nth i lst)))
    
33.   (setq x1 (cdr (nth i lst)))
    
34.         (if (= (car (nth (+ i 4) lst)) 10)
    
35.       (setq x2 (cdr (nth (+ i 4) lst)))
    
36.       (setq x2 nil)
    
37.     )
    
38.    
    
39.     (if (and x1 x2)
    
40.       (progn
    
41.   (setq dist (- (vlax-curve-getDistAtPoint vlent x2) (vlax-curve-getDistAtPoint vlent x1)))
    
42.   (setq x3 (polar zb (angtof "0") dist))
    
43.   (setq zblst (append zblst (list (cons 10 x3)) (list (nth (+ 5 i) lst)) (list (nth (+ 6 i) lst))))
    
44.   (setq  zb x3)
    
45.   (setq i (+ i 4))
    
46.   )
    
47.     (setq i 2)
    
48.       )
    
49.     )
    
50.   (setq zblst (append (list (assoc 0 lst) '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (assoc 90 lst)) zblst))
    
51.    (entmakex zblst)
    
52.   (setq aa (entlast))
    
53. (command ".chprop" aa "" "p" "layer" "--000" "")
    
54.   (setq lstt (entget aa))
    
55.   (setq n 0)
    
56.   (repeat (length lstt)
    
57.     (setq nn (car (nth n lstt)))
    
58.     (if (= nn 10)
    
59.       (progn
    
60.   (setq xy (cdr (nth n lstt)))
    
61.   (setq high (cdr (nth (1+ n) lstt)))
    
62.   (if (and xy (> high 0))
    
63.     (progn
    
64.       (setq xx (cdr (nth (+ n 4) lstt)))
    
65.       (setq xy1 (polar  xy (angtof "90") 200));;;;;;;;;;;;;设框离线高度
    
66.       (setq xy2 (polar xx (angtof "90") 500));;;;;;;;;;;;;;;;设框高度
    
67.       ;(setq textxy (polar xy1 (angle xy1 xy2) (/ (distance xy1 xy2) 3)));算出文字的坐标
    
68.       (setq lr (rtos (distance xy xx) 2 2))
    
69.       (command "rectang" xy1 xy2)
    
70.       (setq Nrec (entlast))
    
71.       (command ".chprop" Nrec "" "p" "layer" "--004" "")
    
72. (command "_array" Nrec ""  "r" 5 "1" 1000 );;;;;;;;;;;;;;;;;;;;;;;;设5阵列数量和1000距离
    
73.      ;(entmakex (list '(0 . "TEXT")  ;用文字写出长度
    
74.           ; (cons 1 lr)
    
75.            ;(cons 10 textxy)
    
76.          ; (CONS 40 1.5)
    
77.       ;)
    
78.    ; )
    
79.   )
    
80.       )
    
81.   )
    
82.       )
    
83.     (setq n (1+ n))
    
84.     )
    
85. (setvar "cmdecho" 1)
    
86. (setvar "osmode" os)
    
87. (princ)
    
88.   )
    

;取lwpoline线变宽的地方，并在上生成方框<br /> ;    xiabin68  <br /> ;    QQ:19539078<br /> ; 以下程序没有加入任何子函数希望对初学有帮助<br /> ;转载请说明出处与作者信息<br /> (defun c:hk ()<br /> (setvar "cmdecho" 0)<br /> (setq os (getvar "osmode"))<br />   (setq ent (car (entsel"\n请选择多段线:")))<br />   (setq vlent (vlax-ename->vla-object ent))<br /> (setq entLEN (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))<br />   (setq zb (getpoint "请选择展开起点:"))<br />   (setvar "osmode" 0)<br /> (setq zb1 (list (+ 3 (car zb))(+ 1000 (cadr zb))));;;;;;;;;;;;设3偏右离起点距离;1000设距高<br /> (setq zb3 (list (+ 3 (car zb))(cadr zb)))<br /> (setq zb2 (list (+ entLEN (car zb1))(+ 1000 (cadr zb))))<br /> (command "_pline" zb1 zb2 "")<br /> (setq cenLine (entlast))<br /> (command ".chprop" cenLine "" "p" "layer" "--008" "");;;;;设线归层<br /> (command "_array" cenLine ""  "r" 5 "1" 1000 );;;;;;;;;;;;;;;;;;;;;设5阵列数量;1000设距高<br /> (command "_.rectang" zb3 (strcat "@" (rtos entLEN 2) "," (rtos 5000 2)));;;;;;;;;;;;;总高度<br /> (command ".chprop" (entlast) "" "p" "layer" "--006" "")<br />   (setq lst (entget ent))<br />   (setq dd (length lst))<br />   (setq zblst '())<br />   (setq i 0)<br />    (while (/= (car (nth i lst)) 10)<br />      (setq i (1+ i))<br />      )<br /> (setq zblst (append zblst (list (cons 10 zb3)) (list (nth (+ 1 i) lst)) (list (nth (+ 2 i) lst)))) <br />   (while (= 10 (car (nth i lst)))<br />   (setq x1 (cdr (nth i lst)))<br />         (if (= (car (nth (+ i 4) lst)) 10)<br />       (setq x2 (cdr (nth (+ i 4) lst)))<br />       (setq x2 nil)<br />     )<br />     <br />     (if (and x1 x2)<br />       (progn<br />   (setq dist (- (vlax-curve-getDistAtPoint vlent x2) (vlax-curve-getDistAtPoint vlent x1)))<br />   (setq x3 (polar zb (angtof "0") dist))<br />   (setq zblst (append zblst (list (cons 10 x3)) (list (nth (+ 5 i) lst)) (list (nth (+ 6 i) lst))))<br />   (setq  zb x3)<br />   (setq i (+ i 4))<br />   )<br />     (setq i 2)<br />       )<br />     )<br />   (setq zblst (append (list (assoc 0 lst) '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (assoc 90 lst)) zblst))<br />    (entmakex zblst)<br />   (setq aa (entlast))<br /> (command ".chprop" aa "" "p" "layer" "--000" "")<br />   (setq lstt (entget aa))<br />   (setq n 0)<br />   (repeat (length lstt)<br />     (setq nn (car (nth n lstt)))<br />     (if (= nn 10)<br />       (progn<br />   (setq xy (cdr (nth n lstt)))<br />   (setq high (cdr (nth (1+ n) lstt)))<br />   (if (and xy (> high 0))<br />     (progn<br />       (setq xx (cdr (nth (+ n 4) lstt)))<br />       (setq xy1 (polar  xy (angtof "90") 200));;;;;;;;;;;;;设框离线高度<br />       (setq xy2 (polar xx (angtof "90") 500));;;;;;;;;;;;;;;;设框高度<br />       ;(setq textxy (polar xy1 (angle xy1 xy2) (/ (distance xy1 xy2) 3)));算出文字的坐标<br />       (setq lr (rtos (distance xy xx) 2 2))<br />       (command "rectang" xy1 xy2)<br />       (setq Nrec (entlast))<br />       (command ".chprop" Nrec "" "p" "layer" "--004" "")<br /> (command "_array" Nrec ""  "r" 5 "1" 1000 );;;;;;;;;;;;;;;;;;;;;;;;设5阵列数量和1000距离<br />      ;(entmakex (list '(0 . "TEXT")  ;用文字写出长度<br />           ; (cons 1 lr)<br />            ;(cons 10 textxy)<br />          ; (CONS 40 1.5)<br />       ;)<br />    ; )<br />   )<br />       )<br />   )<br />       )<br />     (setq n (1+ n))<br />     )<br /> (setvar "cmdecho" 1)<br /> (setvar "osmode" os)<br /> (princ)<br />   )<br />

ww5w

怎么贴出的码变得这么乱?改了也不行.

ww5w

原来真是浏览器的事,换ie可以正常显示了.

xyp1964

立面展开：