[求助]帮忙改进一下我的自己的烂程序

钾肥

下面是我自己写的一个程序，主要功能就是把单线变成双线。
但是有一些缺陷。
缺陷1：如果变成双线的对象在屏幕显示以外，那么就会出错。第二条镜像的线就会镜像的别的地方去。
缺陷2：运行的速度很慢，运行的时候命令行一直会出现命令出错XXX的提示，不过程序还是能正常的跑完。
哪位能帮我看看，有什么办法可以解决？

2. (defun c:DoubleLine ( / WaterPipeWidth 1_osmode num index a ss1 name1 ent1 spt mpt )
3. (setq ss1 (ssget (list (cons 0 "line"))))
4.   ;(setq WaterPipeWidth (getreal "\n输入宽度:"))
5.   (PROMPT "\nEnter a Value:")
6.   (SETQ a (/(GETREAL)2))
7.   (setq num (sslength ss1))
8.   (setq index 0)
9.   (setq 1_osmode (getvar "osmode"))
10.   (setvar "osmode" 0)
11. (repeat num
12.   (setq name1 (ssname ss1 index))
13.   (setq ent1 (entget name1))
14.   (setq spt (cdr (assoc 10 ent1)))
15.   (setq mpt (cdr (assoc 11 ent1)))
16.   (command "offset" a name1 spt "" "" "")
17.   (command "mirror" "l" "" spt mpt "n" "" """")
18.   (COMMAND "CHPROP" name1 "" "c" "9" "lt" "center2" "" "")
19.   (setq index (1+ index))
20. )
21.   (setvar "osmode" 1_osmode)
22.   (princ)
23.   )

(defun c:DoubleLine ( / WaterPipeWidth 1_osmode num index a ss1 name1 ent1 spt mpt ) (setq ss1 (ssget (list (cons 0 "line"))))   ;(setq WaterPipeWidth (getreal "\n输入宽度:"))   (PROMPT "\nEnter a Value:")   (SETQ a (/(GETREAL)2))   (setq num (sslength ss1))   (setq index 0)   (setq 1_osmode (getvar "osmode"))   (setvar "osmode" 0) (repeat num   (setq name1 (ssname ss1 index))   (setq ent1 (entget name1))   (setq spt (cdr (assoc 10 ent1)))   (setq mpt (cdr (assoc 11 ent1)))   (command "offset" a name1 spt "" "" "")   (command "mirror" "l" "" spt mpt "n" "" """")   (COMMAND "CHPROP" name1 "" "c" "9" "lt" "center2" "" "")   (setq index (1+ index)) )   (setvar "osmode" 1_osmode)   (princ)   )

caoyin

2. (defun c:DoubleLine ( / ss1 a index obj)
3.   (if (and (setq ss1 (ssget '((0 . "line"))))
4.            (SETQ a   (GETREAL "\nEnter a Value: "))
5.       )
6.      (progn
7.        (setq a (/ a 2))
8.        (repeat (setq index (sslength ss1))
9.          (setq index (1- index)
10.                obj   (vlax-ename->vla-object (ssname ss1 index))
11.          )
12.          (vla-offset obj a)
13.          (vla-offset obj (- a))
14.        )
15.     )
16.   )
17.   (princ)
18. )

(defun c:DoubleLine ( / ss1 a index obj)   (if (and (setq ss1 (ssget '((0 . "line"))))            (SETQ a   (GETREAL "\nEnter a Value: "))       )      (progn        (setq a (/ a 2))        (repeat (setq index (sslength ss1))          (setq index (1- index)                obj   (vlax-ename->vla-object (ssname ss1 index))          )          (vla-offset obj a)          (vla-offset obj (- a))        )     )   )   (princ) )

钾肥

比我的速度快多了~

为什么？是因为用了vla开头的这种函数吗？

另外能不能把中间的（也就是原来的那条做上下偏移的线）改成中心线，8号色？

ljpnb

3. (defun c:DoubleLine ( / ss1 a index obj)
4.   (if (and (setq ss1 (ssget '((0 . "line"))))
5.            (SETQ a   (GETREAL "\nEnter a Value: "))
6.       )
7.      (progn
8.        (setq a (/ a 2))
9.        (repeat (setq index (sslength ss1))
10.          (setq index (1- index)
11.                obj   (vlax-ename->vla-object (ssname ss1 index))
12.          )  
13.          (vla-offset obj a)
14.          (vla-offset obj (- a))
15.   (vla-put-linetype obj "center")
16.   (setq col(vla-get-truecolor obj))
17.   (vla-put-colorindex col 8)
18.   (vla-put-truecolor obj col)
19.        )
20.     )
21.   )
22.   (princ)
23. )

(defun c:DoubleLine ( / ss1 a index obj)   (if (and (setq ss1 (ssget '((0 . "line"))))            (SETQ a   (GETREAL "\nEnter a Value: "))       )      (progn        (setq a (/ a 2))        (repeat (setq index (sslength ss1))          (setq index (1- index)                obj   (vlax-ename->vla-object (ssname ss1 index))          )            (vla-offset obj a)          (vla-offset obj (- a))   (vla-put-linetype obj "center")   (setq col(vla-get-truecolor obj))   (vla-put-colorindex col 8)   (vla-put-truecolor obj col)        )     )   )   (princ) )

jxh2003zfr

如果不用Vlisp，用这个看看

3. (defun c:DoubleLine ( / WaterPipeWidth 1_osmode num index a ss1 name1 ent1 spt mpt
4.      angSE spt0 mpt0 spt1 mpt1 col lty lstLine)
5. (setq ss1 (ssget (list (cons 0 "line"))))
6.    ;(setq WaterPipeWidth (getreal "\n怀遵僅:"))
7.    (PROMPT "\nEnter a Value:")
8.    (SETQ a (/(GETREAL)2))
9.    (setq num (sslength ss1))
10.    (setq index 0)
11.    (setq 1_osmode (getvar "osmode"))
12.    (setvar "osmode" 0)
13. (repeat num
14.   (setq name1 (ssname ss1 index))
15.   (setq ent1 (entget name1))  
16.    (setq col (cdr (assoc 62 ent1))
17.   lty (cdr (assoc 6 ent1))
18.   spt (cdr (assoc 10 ent1))
19.   mpt (cdr (assoc 11 ent1))
20.   angSE (angle spt mpt)
21.   spt0 (list (- (car spt) (* (sin angSE) a)) (+ (cadr spt) (* (cos angSE) a)))
22.   spt1 (list (+ (car spt) (* (sin angSE) a)) (- (cadr spt) (* (cos angSE) a)))
23.   mpt0 (list (- (car mpt) (* (sin angSE) a)) (+ (cadr mpt) (* (cos angSE) a)))
24.   mpt1 (list (+ (car mpt) (* (sin angSE) a)) (- (cadr mpt) (* (cos angSE) a)))
25.   )
26.   (if (= col nil) (setq col 256)) ;256 means bylayer color
27.   (setq lstLine (list '(0 . "line") (cons 62 col)(cons 10 spt0) (cons 11 mpt0)))
28.   (if (/= lty nil) (setq lstline (append lstline (list (cons 6 lty)))))
29.   (entmake lstLine)
30.   (setq lstLine (list '(0 . "line") (cons 62 col)(cons 10 spt1) (cons 11 mpt1)))
31.   (if (/= lty nil) (setq lstline (append lstline (list (cons 6 lty)))))
32.   (entmake lstLine)
33.   
34.    (COMMAND "CHPROP" name1 "" "c" "9" "lt" "center2" "")
35.    (setq index (1+ index))
36. )
37.    (setvar "osmode" 1_osmode)
38.    (princ)
39.    )

(defun c:DoubleLine ( / WaterPipeWidth 1_osmode num index a ss1 name1 ent1 spt mpt      angSE spt0 mpt0 spt1 mpt1 col lty lstLine) (setq ss1 (ssget (list (cons 0 "line"))))    ;(setq WaterPipeWidth (getreal "\n怀遵僅:"))    (PROMPT "\nEnter a Value:")    (SETQ a (/(GETREAL)2))    (setq num (sslength ss1))    (setq index 0)    (setq 1_osmode (getvar "osmode"))    (setvar "osmode" 0) (repeat num   (setq name1 (ssname ss1 index))   (setq ent1 (entget name1))      (setq col (cdr (assoc 62 ent1))   lty (cdr (assoc 6 ent1))   spt (cdr (assoc 10 ent1))   mpt (cdr (assoc 11 ent1))   angSE (angle spt mpt)   spt0 (list (- (car spt) (* (sin angSE) a)) (+ (cadr spt) (* (cos angSE) a)))   spt1 (list (+ (car spt) (* (sin angSE) a)) (- (cadr spt) (* (cos angSE) a)))   mpt0 (list (- (car mpt) (* (sin angSE) a)) (+ (cadr mpt) (* (cos angSE) a)))   mpt1 (list (+ (car mpt) (* (sin angSE) a)) (- (cadr mpt) (* (cos angSE) a)))   )   (if (= col nil) (setq col 256)) ;256 means bylayer color   (setq lstLine (list '(0 . "line") (cons 62 col)(cons 10 spt0) (cons 11 mpt0)))   (if (/= lty nil) (setq lstline (append lstline (list (cons 6 lty)))))   (entmake lstLine)   (setq lstLine (list '(0 . "line") (cons 62 col)(cons 10 spt1) (cons 11 mpt1)))   (if (/= lty nil) (setq lstline (append lstline (list (cons 6 lty)))))   (entmake lstLine)       (COMMAND "CHPROP" name1 "" "c" "9" "lt" "center2" "")    (setq index (1+ index)) )    (setvar "osmode" 1_osmode)    (princ)    )

钾肥

两个都很好用~谢谢~

特别是二楼的兄弟，别我的程序快多了~

五楼的也不我快。

呵呵~~！现在水管单线变双线容易多了~

carrot1983

5楼的,计算点位,挺有耐心的...

最简单的思路就是偏移.

当然还有一种思路就是用mline...呵呵..这个变化就比较多了...