程序求助

hphkjz

st788796 发表于 2013-11-18 07:05
就是标一个总长度吗

里面的运算不要变，就是在显示出来的长度前面再加一个自定义的单行文字

hphkjz

st788796 发表于 2013-11-18 07:11
(vl-load-com)

小弟愚笨，不太明白这些个涵义，刚刚你发步的那个程序也运行不起来，如果不好弄我只能自己单另加单行文字了，那样麻烦的很了

hphkjz

st788796 发表于 2013-11-18 07:11
(vl-load-com)

哥，我试了试，能运行，挺好的，但是我想“长度是”和后面的数字是分开的两个单行文字，能麻烦哥给再修改一下好吗？

st788796

hphkjz 发表于 2013-11-18 07:45
哥，我试了试，能运行，挺好的，但是我想“长度是”和后面的数字是分开的两个单行文字，能麻烦哥给再修改 ...

"长度是"--->"长度是    "

hphkjz

st788796 发表于 2013-11-18 07:56
"长度是"--->"长度是    "

哥，不行么，试了一下只是在整体中间加了个空格，还是一个整体的字，我想把它分成两个字是为了有一个字在图纸上挪位置的

st788796

hphkjz 发表于 2013-11-18 09:09
哥，不行么，试了一下只是在整体中间加了个空格，还是一个整体的字，我想把它分成两个字是为了有一个字在 ...

那要写两次，用一个对齐点，第一个右对齐，数字左对齐

hphkjz

st788796 发表于 2013-11-18 09:17
那要写两次，用一个对齐点，第一个右对齐，数字左对齐

哥，不太明白怎么的弄了，像一下这个代码运行就是分别出现两个单行字，这是个统计面积长度的代码:

1. (princ "\n程序：统计面积、长度 命令：tj")
   
2. (defun C:tj (/ ss l i totalarea ename obj entarea)
   
3.   (if (setq ss (ssget))
   
4. (progn
   
5. (vl-load-com)
   
6. (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
   
7.       (setq l (sslength ss) i 0 totalarea 0 totlength 0)
   
8. (repeat l
   
9. (setq ename (ssname ss i))
   
10. (setq obj (vlax-ename->vla-object ename))
    
11. (if (vlax-property-available-p obj "area")
    
12. (setq totalarea (+ (vlax-get-property obj 'area) totalarea))
    
13.         )
    
14. (if (= (cdr (assoc 0 (entget ename))) "MLINE")
    
15.    (setq totlength (+ totlength (ml-length ename)))
    
16.    (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
    
17. )
    
18.         (setq i (1+ i))
    
19.       )
    
20.       (setq text1 (strcat "总面积为: " (rtos totalarea 2 0) "平方毫米")
    
21.      text2 (strcat "总长度为: " (rtos totlength 2 0) "毫米")
    
22.       )
    
23.       (if (setq insertpt (getpoint "\n请输入文字插入点: "))
    
24. (if (setq height (getdist "\n请输入文字高度:"))
    
25.    (setq insertp1 (vlax-3d-point insertpt)
    
26.   insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
    
27.          textobj1 (vla-addtext modelspace text1 insertp1 height)
    
28.   textobj2 (vla-addtext modelspace text2 insertp2 height)
    
29.    )
    
30. )
    
31.       )
    
32.     )
    
33.   )
    
34. )
    
35. (defun ml-length (ename / j d ptlist)
    
36. (foreach n (entget ename)
    
37. (if (= (car n) 11)
    
38. (setq ptlist (cons (cdr n) ptlist))
    
39. )
    
40. )
    
41. (reverse ptlist)
    
42. (setq j 0 d 0)
    
43. (repeat (1- (length ptlist))
    
44. (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
    
45.     (setq j (1+ j))
    
46.   )
    
47.   d
    
48. )
    

(princ "\n程序：统计面积、长度 命令：tj")<br /> (defun C:tj (/ ss l i totalarea ename obj entarea)<br />   (if (setq ss (ssget))<br /> (progn<br /> (vl-load-com)<br /> (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))<br />       (setq l (sslength ss) i 0 totalarea 0 totlength 0)<br /> (repeat l<br /> (setq ename (ssname ss i))<br /> (setq obj (vlax-ename->vla-object ename))<br /> (if (vlax-property-available-p obj "area")<br /> (setq totalarea (+ (vlax-get-property obj 'area) totalarea))<br />         )<br /> (if (= (cdr (assoc 0 (entget ename))) "MLINE")<br />    (setq totlength (+ totlength (ml-length ename)))<br />    (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))<br /> )<br />         (setq i (1+ i))<br />       )<br />       (setq text1 (strcat "总面积为: " (rtos totalarea 2 0) "平方毫米")<br />      text2 (strcat "总长度为: " (rtos totlength 2 0) "毫米")<br />       )<br />       (if (setq insertpt (getpoint "\n请输入文字插入点: "))<br /> (if (setq height (getdist "\n请输入文字高度:"))<br />    (setq insertp1 (vlax-3d-point insertpt)<br />   insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))<br />          textobj1 (vla-addtext modelspace text1 insertp1 height)<br />   textobj2 (vla-addtext modelspace text2 insertp2 height)<br />    )<br /> )<br />       )<br />     )<br />   )<br /> )<br /> (defun ml-length (ename / j d ptlist)<br /> (foreach n (entget ename)<br /> (if (= (car n) 11)<br /> (setq ptlist (cons (cdr n) ptlist))<br /> )<br /> )<br /> (reverse ptlist)<br /> (setq j 0 d 0)<br /> (repeat (1- (length ptlist))<br /> (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))<br />     (setq j (1+ j))<br />   )<br />   d<br /> )<br />

st788796

hphkjz 发表于 2013-11-18 09:27
哥，不太明白怎么的弄了，像一下这个代码运行就是分别出现两个单行字，这是个统计面积长度的代码:

http://bbs.xdcad.net/thread-671687-1-1.html

hphkjz

st788796 发表于 2013-11-18 15:48
http://bbs.xdcad.net/thread-671687-1-1.html

哥，我试了试不知道哪儿出了问题还是我不会弄的原因，我觉得代码肯定是没有问题的，我用的是autocad2004的。功能就要和gif图片一样样的。哥，能不能把我原来那个代码修改成这个功能呀？

st788796

hphkjz 发表于 2013-11-18 18:40
哥，我试了试不知道哪儿出了问题还是我不会弄的原因，我觉得代码肯定是没有问题的，我用的是autocad2004 ...

上述链接有演示，加载xdrxapi+xd-lisp-lib.vlx

hphkjz

加载完了，出现了bug。no function definition:VLAX-CURVE-

st788796

hphkjz 发表于 2013-11-18 20:15
加载完了，出现了bug。no function definition:VLAX-CURVE-

最前面加上 (vl-load-com)
里面的函数可以用 xdrx_curve 类的，测试的时候有些问题临时换了 vlax-curve 类

hphkjz

st788796 发表于 2013-11-18 20:19
最前面加上 (vl-load-com)
里面的函数可以用 xdrx_curve 类的，测试的时候有些问题临时换了 vlax-curve  ...

加上也还是不行，还是那个bug，不知道怎么回事。还请哥给弄个完整的代码

st788796

hphkjz 发表于 2013-11-18 20:32
加上也还是不行，还是那个bug，不知道怎么回事。还请哥给弄个完整的代码

1. (defun c:tt (/ ss zh)
   
2.   (if
   
3.     (and (setq ss (ssget '((0 . "*line,arc,ellipse"))))
   
4.          (progn
   
5.            (if (= (setq
   
6.                     zh (getstring (strcat "\n字高<"
   
7.                                           (rtos (getvar "textsize") 2 2)
   
8.                                           ">: "
   
9.                                   )
   
10.                        )
    
11.                   )
    
12.                   ""
    
13.                )
    
14.              (setq zh (getvar "textsize"))
    
15.              (setvar "textsize" (distof zh))
    
16.            )
    
17.            (setq zh (getvar "textsize"))
    
18.          )
    
19.     )
    
20.      (mapcar '(lambda (x / d pmid an txt1 txt2)
    
21.                 (setq d           (xdrx_curve_getdistatpoint
    
22.                              x
    
23.                              (xdrx_curve_getendpoint x)
    
24.                            )
    
25.                       pmid (cadr (xdrx_curve_getpoint x))
    
26.                       an   (XD::Geom:AngleFormat
    
27.                              (angle '(0. 0. 0.)
    
28.                                     (xdrx_curve_getfirstderiv
    
29.                                       x
    
30.                                       (xdrx_curve_getparamatpoint x pmid)
    
31.                                     )
    
32.                              )
    
33.                            )
    
34.                       txt1 (xdrx_text_make
    
35.                              pmid
    
36.                              "长度是"
    
37.                              zh
    
38.                              an
    
39.                            )
    
40.                       txt2 (xdrx_text_make
    
41.                              pmid
    
42.                              (rtos d)
    
43.                              zh
    
44.                              an
    
45.                            )
    
46.                 )
    
47.                 (xdrx_text_setvermode txt1 1) ;_顺序不同会自动调整位置
    
48.                 (xdrx_text_sethozmode txt1 1)
    
49.                 (xdrx_text_setvermode txt2 3)
    
50.                 (xdrx_text_sethozmode txt2 1)
    
51.               )
    
52.              (xdrx_pickset->ents ss)
    
53.      )
    
54.   )
    
55.   (princ)
    
56. )

(defun c:tt (/ ss zh)<br />   (if<br />     (and (setq ss (ssget '((0 . "*line,arc,ellipse"))))<br />          (progn<br />            (if (= (setq<br />                     zh (getstring (strcat "\n字高<"<br />                                           (rtos (getvar "textsize") 2 2)<br />                                           ">: "<br />                                   )<br />                        )<br />                   )<br />                   ""<br />                )<br />              (setq zh (getvar "textsize"))<br />              (setvar "textsize" (distof zh))<br />            )<br />            (setq zh (getvar "textsize"))<br />          )<br />     )<br />      (mapcar '(lambda (x / d pmid an txt1 txt2)<br />                 (setq d           (xdrx_curve_getdistatpoint<br />                              x<br />                              (xdrx_curve_getendpoint x)<br />                            )<br />                       pmid (cadr (xdrx_curve_getpoint x))<br />                       an   (XD::Geom:AngleFormat<br />                              (angle '(0. 0. 0.)<br />                                     (xdrx_curve_getfirstderiv<br />                                       x<br />                                       (xdrx_curve_getparamatpoint x pmid)<br />                                     )<br />                              )<br />                            )<br />                       txt1 (xdrx_text_make<br />                              pmid<br />                              "长度是"<br />                              zh<br />                              an<br />                            )<br />                       txt2 (xdrx_text_make<br />                              pmid<br />                              (rtos d)<br />                              zh<br />                              an<br />                            )<br />                 )<br />                 (xdrx_text_setvermode txt1 1) ;_顺序不同会自动调整位置<br />                 (xdrx_text_sethozmode txt1 1)<br />                 (xdrx_text_setvermode txt2 3)<br />                 (xdrx_text_sethozmode txt2 1)<br />               )<br />              (xdrx_pickset->ents ss)<br />      )<br />   )<br />   (princ)<br /> )

hphkjz

st788796 发表于 2013-11-18 20:38

能够运行了，哥怎么的能够保留到整数，还有数字是右对齐，如何能够相对于夹点居中对齐了？