完善均分程序

szx025

2. (defun C:lg (/ pt1 pt2 l p1 p2 P3 P4 P5 P6 K setq old_OS old_CMD)
   
3. ;;保存系统变量设置
   
4.     (setq old_OS  (getvar "OSMODE")
   
5.       old_CMD (getvar "CMDECHO")
   
6.     )
   
7.      
   
8.     (setvar "CMDECHO" 0)
   
9.     (command "-osnap" "INT")
   
10.   (setq pt1 (getpoint "\n左下角点:"))
    
11.   (setq pt2 (getpoint pt1 "\n右下角点:"))
    
12. (setvar "OSMODE" 0)
    
13.   (setq p1 (polar pt1 (/ pi 2.0) 400))
    
14.   (setq p2 (polar pt2 (/ pi 2.0) 400))
    
15.   (setq p3 (polar pt1 (/ pi 2.0) 800))
    
16.   (setq p4 (polar pt2 (/ pi 2.0) 800))
    
17.   (setq p5 (polar pt1 (/ pi 2.0) 1200))
    
18.   (setq p6 (polar pt2 (/ pi 2.0) 1200))
    
19.   (command "line" p1 p2 "")
    
20.   (command "line" p3 p4 "")
    
21.   (command "line" p5 p6 "")
    
22.   (command "line" pt2 p6 "")
    
23.   (command "line" pt1 p5 "")
    
24.   (command "line" pt1 pt2 "")
    
25.   (setq k (angle pt1 pt2))
    
26.   (setq L (distance pt1 pt2))
    
27.   (setq N (/ L 1200))
    
28.   (setq I 1)
    
29.   (setq P0 Pt1)
    
30. (while (<= i N)
    
31.   (setq P1 (polar p0 (/ pi 2.0) 1200))
    
32.   (command "line" p0 p1 "")
    
33.   (setq p0 (polar p0 k 1200))
    
34.   (setq I (+ i 1))
    
35. )
    
36. ;;恢复系统变量设置
    
37.     (setvar "CMDECHO" old_CMD)
    
38.     (setvar "OSMODE" old_OS)
    
39.     (setq *error* olderr)
    
40.   (princ)
    
41. )
    

(defun C:lg (/ pt1 pt2 l p1 p2 P3 P4 P5 P6 K setq old_OS old_CMD)<br /> ;;保存系统变量设置 <br />     (setq old_OS  (getvar "OSMODE") <br />       old_CMD (getvar "CMDECHO") <br />     ) <br />      <br />     (setvar "CMDECHO" 0) <br />     (command "-osnap" "INT") <br />   (setq pt1 (getpoint "\n左下角点:"))<br />   (setq pt2 (getpoint pt1 "\n右下角点:"))<br /> (setvar "OSMODE" 0)<br />   (setq p1 (polar pt1 (/ pi 2.0) 400))<br />   (setq p2 (polar pt2 (/ pi 2.0) 400))<br />   (setq p3 (polar pt1 (/ pi 2.0) 800))<br />   (setq p4 (polar pt2 (/ pi 2.0) 800))<br />   (setq p5 (polar pt1 (/ pi 2.0) 1200))<br />   (setq p6 (polar pt2 (/ pi 2.0) 1200))<br />   (command "line" p1 p2 "")<br />   (command "line" p3 p4 "")<br />   (command "line" p5 p6 "")<br />   (command "line" pt2 p6 "")<br />   (command "line" pt1 p5 "")<br />   (command "line" pt1 pt2 "")<br />   (setq k (angle pt1 pt2))<br />   (setq L (distance pt1 pt2))<br />   (setq N (/ L 1200))<br />   (setq I 1)<br />   (setq P0 Pt1)<br /> (while (<= i N)<br />   (setq P1 (polar p0 (/ pi 2.0) 1200))<br />   (command "line" p0 p1 "")<br />   (setq p0 (polar p0 k 1200))<br />   (setq I (+ i 1))<br /> )<br /> ;;恢复系统变量设置 <br />     (setvar "CMDECHO" old_CMD) <br />     (setvar "OSMODE" old_OS) <br />     (setq *error* olderr)<br />   (princ)<br /> )<br />

大家新年好。我写的一个小玩意，竖直线的间距是1200，但当最后的距离大于1200小于2400时，最后的距离就是这个值。这个不是我想要得效果，我的想法是当整个长度不是1200的整数倍时，让竖直线的间距按接近1200的值均分这个长度。请高手完善一下

xyp1964

2. ;; tt(间距均分)
   
3. (defun c:tt ()
   
4.   (setq int (Uint 1 "" "垂直数量" int))
   
5.   (while (and (setq pt1 (getpoint "\n左下角点: "))
   
6.               (setq pt2 (getpoint pt1 "\n右下角点: "))
   
7.          )
   
8.     (setq ll  (distance pt1 pt2)
   
9.           dd1 (/ ll 1200.)
   
10.           nn  (fix dd1)
    
11.           nn  (if (= nn dd1)
    
12.                 nn
    
13.                 (1+ nn)
    
14.               )
    
15.           s1  (xyp-line pt1 pt2)
    
16.           s2  (xyp-line pt1 (xyp-Pt2Y pt1 (* int 400)))
    
17.     )
    
18.     (xyp-ArrayRV s1 (1+ int) 400)
    
19.     (xyp-ArrayRH s2 (1+ nn) (/ ll nn 1.))
    
20.   )
    
21.   (princ)
    
22. )

;; tt(间距均分)<br /> (defun c:tt ()<br />   (setq int (Uint 1 "" "垂直数量" int))<br />   (while (and (setq pt1 (getpoint "\n左下角点: "))<br />               (setq pt2 (getpoint pt1 "\n右下角点: "))<br />          )<br />     (setq ll  (distance pt1 pt2)<br />           dd1 (/ ll 1200.)<br />           nn  (fix dd1)<br />           nn  (if (= nn dd1)<br />                 nn<br />                 (1+ nn)<br />               )<br />           s1  (xyp-line pt1 pt2)<br />           s2  (xyp-line pt1 (xyp-Pt2Y pt1 (* int 400)))<br />     )<br />     (xyp-ArrayRV s1 (1+ int) 400)<br />     (xyp-ArrayRH s2 (1+ nn) (/ ll nn 1.))<br />   )<br />   (princ)<br /> )

szx025

谢谢院长，xyp-line xyp-ArrayRV xyp-ArrayRH你的这几个函数能否提供一下

鱼与熊掌

;生成直线

2. (defun cx-mak-line (pt1 pt2 )
   
3.   (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
   
4. )

(defun cx-mak-line (pt1 pt2 )<br />   (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))<br /> )

鱼与熊掌

关于2个阵列.

1. (vla-ArrayRectangular  tc_en_obj rc_chang rc_kuan 1 *small_a *small_a 0.0)

复制代码

ZZXXQQ

2. (defun C:lg (/ pt1 pt2 l p1 p2 P3 P4 P5 P6 K old_OS)
   
3. ;;保存系统变量设置
   
4. (setq old_OS (getvar "OSMODE"))
   
5. (setvar "OSMODE" 32);INT
   
6. (setq pt1 (getpoint "\n左下角点: "))
   
7. (setq pt2 (getpoint pt1 "\n右下角点: "))
   
8. (setvar "OSMODE" 0)
   
9. (setq k (angle pt1 pt2))
   
10. (setq L (distance pt1 pt2))
    
11. (setq N (fix (/ L 1200)))
    
12. (setq dst (/ L N))
    
13. (setq p1 (polar pt1 (/ pi 2) 400))
    
14. (setq p2 (polar pt2 (/ pi 2) 400))
    
15. (setq p3 (polar pt1 (/ pi 2) 800))
    
16. (setq p4 (polar pt2 (/ pi 2) 800))
    
17. (setq p5 (polar pt1 (/ pi 2) 1200))
    
18. (setq p6 (polar pt2 (/ pi 2) 1200))
    
19. (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
    
20. (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
    
21. (entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p6)))
    
22. (entmake (list '(0 . "LINE") (cons 10 p6) (cons 11 pt2)))
    
23. (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt1)))
    
24. (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 p5)))
    
25. (setq P0 Pt1)
    
26. (repeat (1- N)
    
27.   (setq p0 (polar p0 k dis))
    
28.   (setq P1 (polar p0 (/ pi 2) 1200))
    
29.   (entmake (list '(0 . "LINE") (cons 10 p0) (cons 11 p1)))
    
30. )
    
31. (setvar "OSMODE" old_OS)
    
32. (princ)
    
33. )
    

(defun C:lg (/ pt1 pt2 l p1 p2 P3 P4 P5 P6 K old_OS)<br /> ;;保存系统变量设置 <br /> (setq old_OS (getvar "OSMODE"))<br /> (setvar "OSMODE" 32);INT<br /> (setq pt1 (getpoint "\n左下角点: "))<br /> (setq pt2 (getpoint pt1 "\n右下角点: "))<br /> (setvar "OSMODE" 0)<br /> (setq k (angle pt1 pt2))<br /> (setq L (distance pt1 pt2))<br /> (setq N (fix (/ L 1200)))<br /> (setq dst (/ L N))<br /> (setq p1 (polar pt1 (/ pi 2) 400))<br /> (setq p2 (polar pt2 (/ pi 2) 400))<br /> (setq p3 (polar pt1 (/ pi 2) 800))<br /> (setq p4 (polar pt2 (/ pi 2) 800))<br /> (setq p5 (polar pt1 (/ pi 2) 1200))<br /> (setq p6 (polar pt2 (/ pi 2) 1200))<br /> (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))<br /> (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))<br /> (entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p6)))<br /> (entmake (list '(0 . "LINE") (cons 10 p6) (cons 11 pt2)))<br /> (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt1)))<br /> (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 p5)))<br /> (setq P0 Pt1)<br /> (repeat (1- N)<br />   (setq p0 (polar p0 k dis))<br />   (setq P1 (polar p0 (/ pi 2) 1200))<br />   (entmake (list '(0 . "LINE") (cons 10 p0) (cons 11 p1)))<br /> )<br /> (setvar "OSMODE" old_OS)<br /> (princ)<br /> )<br />

szx025

错误: 输入的列表有缺陷

llsheng_73

鱼与熊掌 发表于 2015-2-25 14:34
;生成直线

1. (defun line(argments);;argments==>(list p1 p2 图层 颜色 线型 厚度 线宽)p2以后可依次省略
   
2.   (entmakex(mapcar'cons'(0 10 11 8 62 6 39 370)(cons"line"argments))))

(defun line(argments);;argments==>(list p1 p2 图层 颜色 线型 厚度 线宽)p2以后可依次省略<br />   (entmakex(mapcar'cons'(0 10 11 8 62 6 39 370)(cons"line"argments))))

ymcui

ZZXXQQ 发表于 2015-2-26 08:32

请问如何画出方框里红色的平分线?谢谢