麻烦大神帮我看看我的程序，现在画线部分不执行。

xyp1964

工具箱内置功能

ZZXXQQ

2. (defun C:tt()
   
3. (setvar "CMDECHO" 0)
   
4. (command "-layer" "m" "S3-BEAM-IDEN-HORT" "c" 21 "" "")
   
5. (setq r1 (getvar "userr1"))
   
6. (setq k1 (* 250 (/ r1 100)))
   
7. (setq k2 (* 200 (/ r1 100)))
   
8. (if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str "200.400"))
   
9. (if (= SDQ nil) (setq SDQ "C" DQWZ "居中"))
   
10. (setq stt str)
    
11. (setq TFF 0)
    
12. (while (= TFF 0)
    
13.   (if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str "200.400"))
    
14.   (setq stt str)
    
15.   (setq str (getstring (strcat "\n输入梁截面(*.*)or[上对齐(F)/居中(C)/下对齐(B)]当前{" DQWZ "}:<" stt ">:")))
    
16.   (if (= str "")
    
17.    (setq str stt)
    
18.    (if (not(wcmatch str "*.*"))
    
19.     (setq SDQ (strcase str) DQWZ (if (= SDQ "F") "上对齐" (if (= SDQ "C") "居中" "下对齐")))
    
20.    )
    
21.   )
    
22.   (if (wcmatch str "*.*") (progn
    
23.    (setq TFF 1)
    
24.    (setq LKK (SB_LJM str 1))
    
25.    (setq LGG (SB_LJM str 2))
    
26.    (while (and (setq pc1 (getpoint "\n请输入第一点:"))
    
27.     (setq pc2 (getpoint  pc1 "\n请输入第二点:")))
    
28.     (setvar "CLAYER" "S0-BEAM1")
    
29.     (setq jd0 (angle pc1 pc2))
    
30.     (setq j0 (angtos jd0 0 20))
    
31.     (setq jd1 (+ jd0 (/ pi 2)))
    
32.     (setq pz2 (mapcar '+ pc1 pc2))
    
33.     (setq pzd (mapcar  '(lambda (x) (/ x 2)) pz2) )
    
34.     (if (= DQWZ "上对齐") (setq lks 0 ))
    
35.     (if (= DQWZ "居中")   (setq lks 0.5))
    
36.     (if (= DQWZ "下对齐") (setq lks 1))
    
37.     (setq k3 (+ (* LKK lks) k2))
    
38.     (setq px1 (polar pzd jd1 k3))
    
39.     (setvar "clayer" "S3-BEAM-IDEN-HORT")
    
40.     (command "text" "style" "GB" "MC" px1 k1 j0 sts)
    
41. ;    (command "text" "MC" px1 k1 j0 sts)
    
42.     (if (= SDQ "F") (progn
    
43.      (setq TFF 0)
    
44.      (command "line" pc1 pc2 "")
    
45.      (setq pt1 (polar pc1 (+ jd0 (* 1.5 pi)) LKK))
    
46.      (setq pt2 (polar pc2 (+ jd0 (* 1.5 pi)) LKK))
    
47.      (command "line" pt1 pt2 "")
    
48.     ))
    
49.     (if (= SDQ "C") (progn
    
50.      (setq TFF 0)
    
51.      (setq l1 (/ LKK 2))
    
52.      (setq pt1 (polar pc1 (+ jd0 (* 1.5 pi)) l1))
    
53.      (setq pt2 (polar pc2 (+ jd0 (* 1.5 pi)) l1))
    
54.      (command "line" pt1 pt2 "")
    
55.      (setq pt3 (polar pc1 (+ jd0 (* 0.5 pi)) l1))
    
56.      (setq pt4 (polar pc2 (+ jd0 (* 0.5 pi)) l1))
    
57.      (command "line" pt3 pt4 "")
    
58.     ))
    
59.     (if (= SDQ "B") (progn
    
60.      (setq TFF 0)
    
61.      (command "line" pc1 pc2 "")
    
62.      (setq pt1 (polar pc1 (+ jd0 (* 0.5 pi)) LKK))
    
63.      (setq pt2 (polar pc2 (+ jd0 (* 0.5 pi)) LKK))
    
64.      (command "line" pt1 pt2 "")
    
65.     ))
    
66.    )
    
67.   ))
    
68. )
    
69. (princ)
    
70. )
    
71. ;;;(x)梁截面识别
    
72. (defun SB_LJM(LJM pr)        
    
73. (VL-LOAD-COM)
    
74. (setq LKST "")
    
75. (setq LGST "")
    
76. (setq LJMN (strlen LJM))
    
77. (if (wcmatch LJM "*.*") (progn
    
78.   (setq XDWZ (vl-string-search  "." LJM))   ;;;小数点位置
    
79.   (setq LKFF (atof (substr LJM 1 XDWZ)))    ;;;梁宽实数
    
80.   (setq LGFF (atof (substr LJM (+ XDWZ 2))));;;梁高实数
    
81. ))
    
82. (if (= pr 1)
    
83.   (setq LKLG LKFF)
    
84.   (setq LKLG LGFF)
    
85. )
    
86. LKLG   
    
87. )
    

(defun C:tt()<br /> (setvar "CMDECHO" 0)<br /> (command "-layer" "m" "S3-BEAM-IDEN-HORT" "c" 21 "" "")<br /> (setq r1 (getvar "userr1"))<br /> (setq k1 (* 250 (/ r1 100)))<br /> (setq k2 (* 200 (/ r1 100)))<br /> (if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str "200.400"))<br /> (if (= SDQ nil) (setq SDQ "C" DQWZ "居中"))<br /> (setq stt str)<br /> (setq TFF 0)<br /> (while (= TFF 0)<br />   (if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str "200.400"))<br />   (setq stt str)<br />   (setq str (getstring (strcat "\n输入梁截面(*.*)or[上对齐(F)/居中(C)/下对齐(B)]当前{" DQWZ "}:<" stt ">:")))<br />   (if (= str "")<br />    (setq str stt)<br />    (if (not(wcmatch str "*.*"))<br />     (setq SDQ (strcase str) DQWZ (if (= SDQ "F") "上对齐" (if (= SDQ "C") "居中" "下对齐")))<br />    )<br />   )<br />   (if (wcmatch str "*.*") (progn<br />    (setq TFF 1)<br />    (setq LKK (SB_LJM str 1))<br />    (setq LGG (SB_LJM str 2))<br />    (while (and (setq pc1 (getpoint "\n请输入第一点:"))<br />     (setq pc2 (getpoint  pc1 "\n请输入第二点:")))<br />     (setvar "CLAYER" "S0-BEAM1") <br />     (setq jd0 (angle pc1 pc2))<br />     (setq j0 (angtos jd0 0 20))<br />     (setq jd1 (+ jd0 (/ pi 2)))<br />     (setq pz2 (mapcar '+ pc1 pc2))<br />     (setq pzd (mapcar  '(lambda (x) (/ x 2)) pz2) )<br />     (if (= DQWZ "上对齐") (setq lks 0 )) <br />     (if (= DQWZ "居中")   (setq lks 0.5)) <br />     (if (= DQWZ "下对齐") (setq lks 1)) <br />     (setq k3 (+ (* LKK lks) k2))<br />     (setq px1 (polar pzd jd1 k3))<br />     (setvar "clayer" "S3-BEAM-IDEN-HORT")<br />     (command "text" "style" "GB" "MC" px1 k1 j0 sts)<br /> ;    (command "text" "MC" px1 k1 j0 sts)<br />     (if (= SDQ "F") (progn <br />      (setq TFF 0)<br />      (command "line" pc1 pc2 "")<br />      (setq pt1 (polar pc1 (+ jd0 (* 1.5 pi)) LKK))<br />      (setq pt2 (polar pc2 (+ jd0 (* 1.5 pi)) LKK))<br />      (command "line" pt1 pt2 "")<br />     ))<br />     (if (= SDQ "C") (progn <br />      (setq TFF 0)<br />      (setq l1 (/ LKK 2))<br />      (setq pt1 (polar pc1 (+ jd0 (* 1.5 pi)) l1))<br />      (setq pt2 (polar pc2 (+ jd0 (* 1.5 pi)) l1))<br />      (command "line" pt1 pt2 "")<br />      (setq pt3 (polar pc1 (+ jd0 (* 0.5 pi)) l1))<br />      (setq pt4 (polar pc2 (+ jd0 (* 0.5 pi)) l1))<br />      (command "line" pt3 pt4 "")<br />     ))<br />     (if (= SDQ "B") (progn <br />      (setq TFF 0)<br />      (command "line" pc1 pc2 "")<br />      (setq pt1 (polar pc1 (+ jd0 (* 0.5 pi)) LKK))<br />      (setq pt2 (polar pc2 (+ jd0 (* 0.5 pi)) LKK))<br />      (command "line" pt1 pt2 "")<br />     ))<br />    )<br />   ))<br /> )<br /> (princ)<br /> ) <br /> ;;;(x)梁截面识别<br /> (defun SB_LJM(LJM pr)        <br /> (VL-LOAD-COM)<br /> (setq LKST "")<br /> (setq LGST "")<br /> (setq LJMN (strlen LJM))<br /> (if (wcmatch LJM "*.*") (progn<br />   (setq XDWZ (vl-string-search  "." LJM))   ;;;小数点位置<br />   (setq LKFF (atof (substr LJM 1 XDWZ)))    ;;;梁宽实数<br />   (setq LGFF (atof (substr LJM (+ XDWZ 2))));;;梁高实数<br /> ))<br /> (if (= pr 1)<br />   (setq LKLG LKFF)<br />   (setq LKLG LGFF)<br /> )<br /> LKLG   <br /> )<br />

风流少年时

原来如此，非常感谢版主@ZZXXQQ帮助。谢谢了。

风流少年时

xyp1964 发表于 2015-4-16 13:26
工具箱内置功能

院长你的程序是牛逼，可是我公司电脑安装不上。很早就下过你的程序，无赖用不上。[em0]

风流少年时

ZZXXQQ 发表于 2015-4-16 13:38

也有bug对齐方式改不了了....

llsheng_73

30.    (if (= DQWZ "上对齐") (setq lks 0 ))
31.    (if (= DQWZ "居中")   (setq lks 0.5))
32.    (if (= DQWZ "下对齐") (setq lks 1))
===>
(setq lks(cdr(assoc DQWZ'(("上对齐" . 0)("居中" . 0.5)("下对齐" . 1)))))
或者
(setq lks(last(assoc DQWZ'(("上对齐"0)("居中"0.5)("下对齐"1)))))

风流少年时

llsheng_73 发表于 2015-4-16 14:55
30.    (if (= DQWZ "上对齐") (setq lks 0 ))
31.    (if (= DQWZ "居中")   (setq lks 0.5))
32.     ...

没用，循环感觉有问题，大神你修改的部分我对齐方式是可以用的，ZZXXXQQ大神修改的地方我对齐方式改不了，你修改过的会在选择对齐方式的时候在最后一次绘图区出现两条线。

风流少年时

风流少年时 发表于 2015-4-16 15:16
没用，循环感觉有问题，大神你修改的部分我对齐方式是可以用的，ZZXXXQQ大神修改的地方我对齐方式改不了， ...

测试过了，没有问题了少了个判断，就让对齐方式没有改变了，谢谢ZZXXQQ大神的出手相助！