{已解决}问个注记建筑物边长的问题

a170285

请教下,怎么能让(setq bz (ssget))这句话只选取闭合的线????
还有就是用南方CASS里面的这个命令"BIANCHANG"注记边长,出来的边长字体大小为0.28呢?
我怎么弄都搞不明白..请教各位大大们
(defun c:11()  
  (setq cmdecho_bak (getvar "cmdecho"))      ;;;备份响应变量
  (setvar "cmdecho" 0)                       ;;;关闭响应变量
  (setq bz (ssget '((0 . "lwpolyline");只
                    (-4 . "<or")      ;选
                    (70 . 1)          ;取
                    (70 . 129)        ;闭合
                    (-4 . "or>"))))   ;线
  (repeat (setq len (sslength bz))
          (setq te (ssname bz (setq len (1- len))))
          (command "BIANCHANG" te "")
  )
  (setvar "cmdecho" cmdecho_bak)              ;;;开启响应变量
  )
  
不知道为什么我这样写如果超过2个封闭的多段线..CAD就会说.出现致命错误

mpk023

Gu_xl 发表于 2011-4-7 18:54
回复 a170285 的帖子

老师你的这个不能框选多个闭合的多段线吗

Gu_xl

回复 a170285 的帖子

(ssget '((0 . "lwpolyline")(-4 . "<or") (70 . 1)(70 . 129)(-4 . "or>")))
(ssget '((0 . "text") (40 . 0.28)))

a170285

回复 Gu_xl 的帖子

版主那个(-4 . "<or")(-4 . "or>")这个两个什么意思?????不懂.....

还有下面那句...我的意思是说..让"BIANCHANG"这个命令注记出来的数字大小是0.28喔..
不是选取

snddd2000

(70 . 1)不是就代表闭合的了吗？

a170285

回复 snddd2000 的帖子

那怎么做菜能让他用了"BIANCHANG"这个命令后标记出来的数字大小是0.28呢?

snddd2000

回复 a170285 的帖子

cass没用过

a170285

回复 snddd2000 的帖子

那如果不用那个命令..那如何可以做到我所说的呢??
请指点下..谢谢

snddd2000

不知道为什么我这样写如果超过2个封闭的多段线..CAD就会说.出现致命错误
是因为你的"BIANCHANG"命令是注册的内部命令。没有解决之道
除非你知道"BIANCHANG"的函数，直接调用该函数，而不是用命令

a170285

回复 snddd2000 的帖子

那如果我不用那个命令..那我改怎么做到注记自己框选的闭合线的边长吗?
能指点下吗?

Gu_xl

回复 a170285 的帖子

1. (defun c:tt (/ obj pianju sHandle  pt np gx bj np xc  rr  cp n ang1 zjp ms AddText)
   
2. ;;;构造text
   
3.   (defun AddText (obj TextString  InsertionPoint  Height xz kb qx Alignment style / obj1 err)
   
4.   (setq obj1 (vla-addtext obj TextString  (vlax-3d-point InsertionPoint)  Height))
   
5.   (vla-put-Rotation obj1 xz)
   
6.   (vla-put-ScaleFactor obj1 kb)
   
7.   (vla-put-ObliqueAngle obj1 qx)
   
8.   (vla-put-alignment obj1 Alignment)
   
9.   (if (/= Alignment acAlignmentLeft)
   
10.     (vla-put-TextAlignmentPoint obj1 (vlax-3d-point InsertionPoint))
    
11.     (vla-put-InsertionPoint obj1 (vlax-3d-point InsertionPoint))
    
12.    )
    
13.    (VL-CATCH-ALL-APPLY 'vla-put-StyleName (list obj1 style))
    
14.   obj1
    
15.   )
    
16. (setq pi2 (/ pi 2))
    
17.   (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    
18. (while (setq pen (car (entsel "\n选择多段线：")))
    
19.   (setq        bcHeight 0.28 ;_ 字高
    
20.         kgb         0.8 ;_ 宽高比
    
21.         Style         "standard" ;_ 字体
    
22.         ZJWS         2 ;_ 注记位数
    
23.         DimScale 1 ;_ 边长尺度，若单位为mm,该值为1000
    
24.         flag         nil ;_ 标注在多段线走向的右侧,T 左侧
    
25.   ) ;_ setq
    
26.   (setq pianju (* bcHeight 0.7)) ;_ 边长离线距离
    
27.   (setq obj (vlax-ename->vla-object pen)
    
28.         n 0)
    
29.   (while (and (setq pt (vlax-curve-getPointAtParam obj n))
    
30.               (setq np (vlax-curve-getPointAtParam obj (1+ n)))
    
31.          ) ;_ 结束and
    
32.     (if        (/= 0.0 (setq bugle (vla-GetBulge obj n)))
    
33.       (progn
    
34.         (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))
    
35.              bj (* (atan (abs bugle)) 4)
    
36.             xc (* 0.5 (distance Pt np))
    
37.             gg (abs (* bugle xc))
    
38.             rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
    
39.             ang1 (angle pt np)
    
40.             cp (polar Pt ang1 xc)
    
41.             cp (polar midpt (angle midpt cp) rr)
    
42.             bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale) 2 ZJWS)
    
43.               )
    
44.         (if flag
    
45.             (setq zjp (polar midpt (cond ((> bugle 0)(angle midpt cp))(t (angle  cp midpt))) pianju))
    
46.             (setq zjp  (polar midpt (cond ((> bugle 0)(angle  cp midpt))(t (angle midpt cp))) pianju))
    
47.       )
    
48.         (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (< ang1 (* 2.0 pi)))))
    
49.           (setq ang1 (- ang1 pi))
    
50.           )
    
51.         (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)
    
52.       );progn
    
53.       (progn
    
54.         (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))
    
55.               ang1 (angle pt np)
    
56.               bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale)  2 ZJWS)
    
57.               )
    
58.         (if flag
    
59.             (setq zjp (polar midpt (+ pi2 ang1) pianju))
    
60.           (setq zjp (polar midpt (- ang1 pi2) pianju))
    
61.                )
    
62.         (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (<= ang1 (* 2.0 pi)))))
    
63.           (setq ang1 (- ang1 pi))
    
64.           )
    
65.         (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)
    
66.       );progn
    
67.     ) ;_ 结束if
    
68.     (setq n (1+ n))
    
69.   ) ;_ 结束while
    
70. )
    
71.   (princ)
    
72.   )
    

(defun c:tt (/ obj pianju sHandle  pt np gx bj np xc  rr  cp n ang1 zjp ms AddText)<br /> ;;;构造text<br />   (defun AddText (obj TextString  InsertionPoint  Height xz kb qx Alignment style / obj1 err)<br />   (setq obj1 (vla-addtext obj TextString  (vlax-3d-point InsertionPoint)  Height))<br />   (vla-put-Rotation obj1 xz)<br />   (vla-put-ScaleFactor obj1 kb)<br />   (vla-put-ObliqueAngle obj1 qx)<br />   (vla-put-alignment obj1 Alignment)<br />   (if (/= Alignment acAlignmentLeft)<br />     (vla-put-TextAlignmentPoint obj1 (vlax-3d-point InsertionPoint))<br />     (vla-put-InsertionPoint obj1 (vlax-3d-point InsertionPoint))<br />    )<br />    (VL-CATCH-ALL-APPLY 'vla-put-StyleName (list obj1 style))<br />   obj1<br />   )<br /> (setq pi2 (/ pi 2))<br />   (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))<br /> (while (setq pen (car (entsel "\n选择多段线：")))<br />   (setq        bcHeight 0.28 ;_ 字高<br />         kgb         0.8 ;_ 宽高比<br />         Style         "standard" ;_ 字体<br />         ZJWS         2 ;_ 注记位数<br />         DimScale 1 ;_ 边长尺度，若单位为mm,该值为1000<br />         flag         nil ;_ 标注在多段线走向的右侧,T 左侧<br />   ) ;_ setq<br />   (setq pianju (* bcHeight 0.7)) ;_ 边长离线距离<br />   (setq obj (vlax-ename->vla-object pen)<br />         n 0)<br />   (while (and (setq pt (vlax-curve-getPointAtParam obj n))<br />               (setq np (vlax-curve-getPointAtParam obj (1+ n)))<br />          ) ;_ 结束and<br />     (if        (/= 0.0 (setq bugle (vla-GetBulge obj n)))<br />       (progn<br />         (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))<br />              bj (* (atan (abs bugle)) 4)<br />             xc (* 0.5 (distance Pt np))<br />             gg (abs (* bugle xc))<br />             rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))<br />             ang1 (angle pt np)<br />             cp (polar Pt ang1 xc)<br />             cp (polar midpt (angle midpt cp) rr)<br />             bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale) 2 ZJWS)<br />               )<br />         (if flag<br />             (setq zjp (polar midpt (cond ((> bugle 0)(angle midpt cp))(t (angle  cp midpt))) pianju))<br />             (setq zjp  (polar midpt (cond ((> bugle 0)(angle  cp midpt))(t (angle midpt cp))) pianju))<br />       )<br />         (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (< ang1 (* 2.0 pi)))))<br />           (setq ang1 (- ang1 pi))<br />           )<br />         (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)<br />       );progn<br />       (progn<br />         (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))<br />               ang1 (angle pt np)<br />               bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale)  2 ZJWS)<br />               )<br />         (if flag<br />             (setq zjp (polar midpt (+ pi2 ang1) pianju))<br />           (setq zjp (polar midpt (- ang1 pi2) pianju))<br />                )<br />         (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (<= ang1 (* 2.0 pi)))))<br />           (setq ang1 (- ang1 pi))<br />           )<br />         (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)<br />       );progn<br />     ) ;_ 结束if<br />     (setq n (1+ n))<br />   ) ;_ 结束while<br /> )<br />   (princ)<br />   )<br />