文字下面的线段以及多段线等删除
<p>写一行文字</p><p>下面有线段、多短线等 </p><p>如何能实现写字的同时</p><p>把下面的线段删除？</p> 怎么没有人跟呢 ？ 有同感，请高手指点。 <p>我来也:</p><p>(defun *$dyq-error$* (msg)<br/> ;(command ".undo" "")<br/> (setq *error* &olderr&)<br/> ;(princ)<br/>)</p><p>(defun dyq-get-chaji (xz1 xz2) ;两个选择集的差集<br/> (command "select" xz1 "r" xz2 "")<br/> (ssget "p")<br/>)</p><p>(defun dyq-get-jiaoji (xz1 xz2) ;两个选择集的交集<br/> (command "select" xz1 "r" xz2 "")<br/> (command "select" xz1 "r" (ssget "p") "")<br/> (ssget "p")<br/>)</p><p>(defun dyq-get-bingji (xz1 xz2) ;两个选择集的并集<br/> (command "select" xz1 "a" xz2 "")<br/> (ssget "p")<br/>)</p><p>(defun dyq-get-oldstatus (/ oldstatus) ;存储系统原状态<br/> (setq oldstatus (list "oldstatus"))<br/> (setq oldstatus (cons "CLAYER" oldstatus))<br/> (setq oldstatus (cons (getvar "CLAYER") oldstatus))<br/> (setq oldstatus (cons "OSMODE" oldstatus))<br/> (setq oldstatus (cons (getvar "OSMODE") oldstatus))<br/> (setq oldstatus (cons "ORTHOMODE" oldstatus))<br/> (setq oldstatus (cons (getvar "ORTHOMODE") oldstatus))<br/> (setq oldstatus (cons "TEXTSTYLE" oldstatus))<br/> (setq oldstatus (cons (getvar "TEXTSTYLE") oldstatus))<br/> (setq oldstatus (cons "TEXTSIZE" oldstatus))<br/> (setq oldstatus (cons (getvar "TEXTSIZE") oldstatus))<br/> (setq oldstatus (cons "PICKSTYLE" oldstatus))<br/> (setq oldstatus (cons (getvar "PICKSTYLE") oldstatus))<br/> (setq oldstatus (cons "pickbox" oldstatus))<br/> (setq oldstatus (cons (getvar "pickbox") oldstatus))<br/> ;当前标注样式要修改<br/> (setq oldstatus (reverse oldstatus))<br/>)</p><p>(defun dyq-put-oldstatus (oldstatus) ;还原系统原系统变量<br/> (setq num (length oldstatus))<br/> (setq i 1)<br/> (repeat (/ (- num 1) 2)<br/> (setvar (nth i oldstatus) (nth (+ i 1) oldstatus))<br/> (setq i (+ i 2))<br/> )<br/>)</p><p> ;获得文字的宽度<br/>(defun dyq-get-string-netwide (obj / objlist minp maxp ang) ;文字净宽<br/> (setq objlist (entget obj))<br/> (setq ang (cdr (assoc '50 objlist)))<br/> (setq objlist (subst '(50 . 0) (assoc '50 objlist) objlist))<br/> (entmod objlist)<br/> (setq objinsertpnt (cdr (assoc '10 objlist)))<br/> (vla-getboundingbox<br/> (vlax-ename->vla-object obj)<br/> 'minp<br/> 'maxp<br/> )<br/> (setq minp (vlax-safearray->list minp))<br/> (setq maxp (vlax-safearray->list maxp))<br/> (setq objlist (subst (cons 50 ang) (assoc '50 objlist) objlist))<br/> (entmod objlist)<br/> (- (car maxp) (car minp))<br/>)</p><p>(princ "\nzx 文字加下划线")<br/>(defun c:zx (/ xz num i obj minp maxp x1 y1 x2 y2 txtang txtpoint oldlayer shenchu gaptextline)<br/> (setq &olderr& *error*)<br/> (setq *error* *$dyq-error$*)<br/> (setq oldstatus (dyq-get-oldstatus))<br/> (dyq-new-layer "T图名" 6)<br/> (setvar "clayer" "T图名")<br/> (setvar "OSMODE" 0)<br/> (setq zxfilename "c:/zx.txt")<br/> (if (findfile zxfilename)<br/> (progn<br/> (setq f (open zxfilename "r"))<br/> (if (setq numline (read-line f))<br/> (setq numline (atoi numline))<br/> (progn<br/> (setq numline 1)<br/> )<br/> )<br/> (close f)<br/> )<br/> (setq numline 1)<br/> )<br/> (setq oldnumline numline)<br/> (if (setq numline (getint (strcat "\n[单下划线(1)/双下划线(2)]<"<br/> (itoa numline)<br/> ">:"<br/> )<br/> )<br/> )<br/> ()<br/> (setq numline oldnumline)<br/> )<br/> ;保存到数据文件<br/> (setq f (open zxfilename "w"))<br/> (write-line (itoa numline) f)<br/> (close f)</p><p> (setq shenchu 200) ;直线伸出的长度<br/> (setq gaptextline 200) ;文字与直线的间距<br/> (setq gapline 100) ;双下划线间距<br/> (setq biglinewide 70) ;下划线粗线线宽<br/> (setq smalllinewide 0) ;下划线细线线宽<br/> (if (setq xz (ssget '((0 . "*TEXT,LWPOLYLINE,LINE"))))<br/> (progn<br/> (setq xzline (ssget "x" '((0 . "LWPOLYLINE,LINE"))))<br/> (setq xzline (dyq-get-jiaoji xz xzline))<br/> (setq xztext (dyq-get-chaji xz xzline))<br/> (command "erase" xzline "")<br/> (setq num (sslength xztext))<br/> (setq i 0)<br/> (repeat num<br/> (setq obj (ssname xztext i))<br/> (setq objlist (entget obj))<br/> (setq txtang (cdr (assoc '50 objlist)))<br/> (setq pt (cdr (assoc '10 objlist)))<br/> (setq txtlen (dyq-get-string-netwide obj))<br/> (setq p1 (polar (polar pt (- txtang (* 0.5 pi)) gaptextline)<br/> (+ txtang pi)<br/> shenchu<br/> )<br/> )<br/> (setq p2 (polar p1 (- txtang (* 0.5 pi)) gapline))<br/> (command "pline" ;如果是单下划线则绘制细线<br/> p1<br/> "w"<br/> biglinewide<br/> biglinewide<br/> (polar p1 txtang (+ shenchu shenchu txtlen))<br/> ""<br/> )<br/> (if (= numline 2.0) ;如果是双下划线则绘制细线<br/> (command "pline"<br/> p2<br/> "w"<br/> smalllinewide<br/> smalllinewide<br/> (polar p2 txtang (+ shenchu shenchu txtlen))<br/> ""<br/> )<br/> )<br/> (setq i (+ i 1))<br/> )<br/> )<br/> )</p><p> (dyq-put-oldstatus oldstatus)<br/> (setq *error* &olderr&)<br/> (princ)<br/>) ;zx结束</p> <p>这是删直线程式：</p><p></p><p><strong>(defun c:sx()<br/> (prompt "/n 请选择要删除的直线")<br/> (setq s2 (ssget<br/> (list (cons -4 "<or")(cons 0 "line")<br/> (cons -4 "or>")<br/> )));;选择物体。<br/> (if (= s2 nil)(exit))<br/> (setq index 0)</strong></p><p><strong><br/> (command "erase" s2 "")<br/> (prin1)<br/> )</strong></p>
页:
[1]