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

cxs259 · 发表于 2011-4-6 17:20:54

;;;***********************************
;;; 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

听见天晴 · 发表于 2023-12-15 21:43:45

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

xiaxiang · 发表于 2011-4-7 10:31:51

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

cxs259 · 发表于 2011-4-7 16:01:20

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

cxs259 · 发表于 2011-4-7 17:04:37

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

xyp1964 · 发表于 2011-4-7 17:55:34

pedit j 0

cxs259 · 发表于 2011-4-8 08:43:59

请问版主是怎么做到的

xiaxiang · 发表于 2011-4-8 09:12:52

本帖最后由 xiaxiang 于 2011-4-10 18:04 编辑

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

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

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

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

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

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

cxs259 · 发表于 2011-4-8 10:50:52

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

xiaxiang · 发表于 2011-4-8 11:02:38

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

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

cxs259 · 发表于 2011-4-8 11:38:31

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

账号		自动登录	找回密码
密码			注册

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

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源