求助能否做到如下程序一样，做到文字加外框效果，给line线画的图形加矩形框？

cxs259

;;;***********************************
;;; No.16-1 单行/多行文本加框 函数   
;;;***********************************
(defun C:JK (/ SS1 n BoxType roundSpace i txtEntData txtEntName txtEntType tBox Pt_BL Pt_BR
                PtTL PtTR Pt_MC xWidth xHeight xAngle)

;(AYCMDINIT0);保存用户系统变量.
(if (= #AY_TBOXRSPACE nil) (setq #AY_TBOXRSPACE 0.5))
(if (= #AY_TBOXBOXTYPE nil) (setq #AY_TBOXBOXTYPE "R"))
(setvar "osmode" 0)
(initget "Mtext Text All")
(setq SelType (getkword "\n选择类型 多行文本(Mtext)/单行文本(Text)/任意<All> "))
(if (null SelType)
  (setq SelType "All")
);endif
(cond ((= SelType "Mtext") (setq SS1 (ssget '((0 . "MTEXT")))));多行文本
    ((= SelType "Text") (setq SS1 (ssget '((0 . "TEXT")))));Text文本
    ((= SelType "All") (setq SS1 (ssget '((0 . "*TEXT")))));任意类型文本
);endcond
(if (null SS1) (progn (princ "\n没有文本实体被选择!") (exit)))
(setq n (sslength SS1))
(if (not (= nil n));No select objects
  (progn
   (initget "C R")
    (setq BoxType (getkword (strcat "\n边框类型 圆形(C)/矩形(R)<" #AY_TBOXBOXTYPE ">: ")))
    (if (= BoxType nil) (setq BoxType #AY_TBOXBOXTYPE) (setq #AY_TBOXBOXTYPE BoxType))
    (setq roundSpace (getreal (strcat "\n文本距离边框偏移距<" (rtos #AY_TBOXRSPACE 2)">: ")))
    (if (= roundSpace nil) (setq roundSpace #AY_TBOXRSPACE) (setq  #AY_TBOXRSPACE roundSpace))
    (setq i 0)
    (while (< i n)
     (setq txtEntName (ssname SS1 i))
     (setq txtEntData (entget txtEntName))
     (setq i (+ i 1))
     (setq txtEntType (cdr (assoc 0 txtEntData)));get Entity's name: "TEXT" or "MTEXT"
     (if (= txtEntType "TEXT");this object is simple line text
      (progn
       (vl-cmdf "ucs" "Object" txtEntName);定义用户坐标系到文本的方向.
       (setq tBox (textbox (list (car txtEntData)));must change to a list
          Pt_BL (car tBox);left bottom point coords
          PtTR (cadr tBox);right top point coords
          PtTL (list (car Pt_BL) (cadr PtTR))
          Pt_BR (list (car PtTR) (cadr Pt_BL))
          Pt_MC (polar Pt_BL (angle Pt_BL PtTR) (/ (distance Pt_BL PtTR) 2.0))
       );endsetq
       (if (= BoxType "C");圆形边框.
        (vl-cmdf "_Circle" Pt_MC (+ (distance Pt_MC Pt_BL) roundSpace))
       );End_if
       (if (= BoxType "R");矩形边框.
        (progn
         (setq Pt_BL (polar Pt_BL PI roundSpace))
         (setq Pt_BL (polar Pt_BL (* PI 1.5) roundSpace))
         (setq Pt_BR (polar Pt_BR 0.0 roundSpace))
         (setq Pt_BR (polar Pt_BR (* PI 1.5) roundSpace))
         (setq PtTL (polar PtTL PI roundSpace))
         (setq PtTL (polar PtTL (* PI 0.5) roundSpace))
         (setq PtTR (polar PtTR 0.0 roundSpace))
         (setq PtTR (polar PtTR (* PI 0.5) roundSpace))
         (vl-cmdf "_PLine" Pt_BL Pt_BR PtTR PtTL "C")
        ); progn
       ); if
        (vl-cmdf "ucs" "p");恢复原有坐标。
      ); progn
     ); if
     (if (= txtEntType "MTEXT")
      (progn
       (vl-cmdf "_.JustifyText" txtEntName "" "TL");处理为对对齐模式为: "左上".
       (setq txtEntData (entget txtEntName))
       (setq PtTL  (cdr (assoc 10 txtEntData))
          xWidth (cdr (assoc 42 txtEntData))
          xHeight (cdr (assoc 43 txtEntData))
          xAngle (cdr (assoc 50 txtEntData))
          Pt_TC  (polar PtTL xAngle (* xWidth 0.5))
          PtTR  (polar PtTL xAngle xWidth)
          Pt_BL  (polar PtTL (- xAngle (/ PI 2.0)) xHeight)
          Pt_BC  (polar Pt_BL xAngle (* xWidth 0.5))
          Pt_BR  (polar Pt_BL xAngle xWidth)
          Pt_MC  (polar Pt_BL (angle Pt_BL PtTR) (/ (distance Pt_BL PtTR) 2.0))
       );endsetq
       (if (= BoxType "C");圆形边框.
        (vl-cmdf "_Circle" Pt_MC (+ (distance Pt_MC Pt_BL) roundSpace))
       );endif
       (if (= BoxType "R");矩形边框.
        (progn
          (setq xAngle (cdr (assoc 50 txtEntData)))
          (setq Pt_BL (polar Pt_BL xAngle (- roundSpace)))
          (setq Pt_BL (polar Pt_BL (+ xAngle (/ PI 2.0)) (- roundSpace)))
          (setq Pt_BR (polar Pt_BR xAngle roundSpace))
          (setq Pt_BR (polar Pt_BR (+ xAngle (/ PI 2.0)) (- roundSpace)))
          (setq PtTL (polar PtTL xAngle (- roundSpace)))
          (setq PtTL (polar PtTL (+ xAngle (/ PI 2.0)) roundSpace))
          (setq PtTR (polar PtTR xAngle roundSpace))
          (setq PtTR (polar PtTR (+ xAngle (/ PI 2.0)) roundSpace))
          (vl-cmdf "_PLine" Pt_BL Pt_BR PtTR PtTL "C")
        ); progn
       ); if
      ); progn
     ); if
    ); while
  ); progn
);End_ if
;(AYCMDINIT1);恢复用户系统变量.
); defun

听见天晴

为什么不能下载附件。。。特定用户

xiaxiang

请楼主说明一下，是要在样图中连接线段成多义线，还是绘制矩形外框？

cxs259

绘制矩形外框，即套上一个矩形外框

cxs259

已购买了你tt4.lsp程序，但用不起来，不知怎么回事？

xyp1964

pedit j 0

cxs259

请问版主是怎么做到的

xiaxiang

如果只是批量连接线段，可用钮广春的程序，就是PEDIT

如果是生成外框可用Gu_xl版主的程序

或者这个程序,注意模糊距离选到1000以上


注意我的tt4程序不是用在这个场合。
我的一个简单代码如下：

2. (defun c:test()
   
3. (setq os (getvar "osmode"))
   
4. (setq ech (getvar "cmdecho"))
   
5. (setvar "peditaccept" 1)
   
6. (setvar  "cmdecho" 0)
   
7. (setq s (ssget))
   
8. (command "_pedit" "m" s "" "j" 10 "")
   
9. ;(setq  ss (ssget "_i"))
   
10. (setq  ss (ssget ))
    
11. (setq n  0
    
12.     mn (sslength ss)
    
13.     )
    
14.     (repeat mn
    
15.       (setq en     (ssname ss n))
    
16.     (setq n (1+ n))
    
17. (if (< os 16384) (setvar "osmode" (+ os 16384)))
    
18. (command "zoom" "o" en "")
    
19. (setq p1 (getvar "extmin"))
    
20. (setq p2 (getvar "extmax"))
    
21. (command "rectang" p1 p2)
    
22. (command "zoom" "p")
    
23. )          ;repeat
    
24. (setvar "osmode" os)
    
25. (setvar "cmdecho" ech)
    
26. (princ)
    
27. )

(defun c:test()<br /> (setq os (getvar "osmode"))<br /> (setq ech (getvar "cmdecho"))<br /> (setvar "peditaccept" 1)<br /> (setvar  "cmdecho" 0)<br /> (setq s (ssget))<br /> (command "_pedit" "m" s "" "j" 10 "")<br /> ;(setq  ss (ssget "_i"))<br /> (setq  ss (ssget ))<br /> (setq n  0<br />     mn (sslength ss)<br />     )<br />     (repeat mn<br />       (setq en     (ssname ss n))<br />     (setq n (1+ n))<br /> (if (< os 16384) (setvar "osmode" (+ os 16384)))<br /> (command "zoom" "o" en "")<br /> (setq p1 (getvar "extmin"))<br /> (setq p2 (getvar "extmax"))<br /> (command "rectang" p1 p2)<br /> (command "zoom" "p")<br /> )          ;repeat<br /> (setvar "osmode" os)<br /> (setvar "cmdecho" ech)<br /> (princ)<br /> )

要分两步，第一步连接线段，第二步通过取得图元坐标角点绘制矩形。用pedit连接生成多义线，这里要两个ssget,有没有更好的办法？

cxs259

谢谢7楼的兄弟，请您能否把TT4的场合改一下？相信很多人会用到的

xiaxiang

cxs259 发表于 2011-4-8 10:50
谢谢7楼的兄弟，请您能否把TT4的场合改一下？相信很多人会用到的

tt4是绘制不规则图形的外框

cxs259

就是需要不规则外框，因为可以用到墙面扣除门窗面积的计算