求助能否做到如下程序一样，做到文字加外框效果，给line线画的图形加矩形框？
;;;***********************************;;; 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 为什么不能下载附件。。。特定用户 请楼主说明一下，是要在样图中连接线段成多义线，还是绘制矩形外框？ 绘制矩形外框，即套上一个矩形外框 已购买了你tt4.lsp程序，但用不起来，不知怎么回事？
pedit j 0
请问版主是怎么做到的 本帖最后由 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 "")
;(setqss (ssget "_i"))
(setqss (ssget ))
(setq n0
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,有没有更好的办法？
谢谢7楼的兄弟，请您能否把TT4的场合改一下？相信很多人会用到的
cxs259 发表于 2011-4-8 10:50 static/image/common/back.gif
谢谢7楼的兄弟，请您能否把TT4的场合改一下？相信很多人会用到的
tt4是绘制不规则图形的外框 就是需要不规则外框，因为可以用到墙面扣除门窗面积的计算
页:
[1]
2