文字下面的线段以及多段线等删除

abcxyz0517

写一行文字

下面有线段、多短线等

如何能实现写字的同时

把下面的线段删除？

abcxyz0517

怎么没有人跟呢 ？

TLHMQH

有同感，请高手指点。

dengqiaqia

我来也:

(defun *$dyq-error$* (msg)
  ;(command ".undo" "")
  (setq *error* &olderr&)
  ;(princ)
)

(defun dyq-get-chaji (xz1 xz2) ;两个选择集的差集
  (command "select" xz1 "r" xz2 "")
  (ssget "p")
)

(defun dyq-get-jiaoji (xz1 xz2) ;两个选择集的交集
  (command "select" xz1 "r" xz2 "")
  (command "select" xz1 "r" (ssget "p") "")
  (ssget "p")
)

(defun dyq-get-bingji (xz1 xz2) ;两个选择集的并集
  (command "select" xz1 "a" xz2 "")
  (ssget "p")
)

(defun dyq-get-oldstatus (/ oldstatus) ;存储系统原状态
  (setq oldstatus (list "oldstatus"))
  (setq oldstatus (cons "CLAYER" oldstatus))
  (setq oldstatus (cons (getvar "CLAYER") oldstatus))
  (setq oldstatus (cons "OSMODE" oldstatus))
  (setq oldstatus (cons (getvar "OSMODE") oldstatus))
  (setq oldstatus (cons "ORTHOMODE" oldstatus))
  (setq oldstatus (cons (getvar "ORTHOMODE") oldstatus))
  (setq oldstatus (cons "TEXTSTYLE" oldstatus))
  (setq oldstatus (cons (getvar "TEXTSTYLE") oldstatus))
  (setq oldstatus (cons "TEXTSIZE" oldstatus))
  (setq oldstatus (cons (getvar "TEXTSIZE") oldstatus))
  (setq oldstatus (cons "PICKSTYLE" oldstatus))
  (setq oldstatus (cons (getvar "PICKSTYLE") oldstatus))
  (setq oldstatus (cons "pickbox" oldstatus))
  (setq oldstatus (cons (getvar "pickbox") oldstatus))
  ;当前标注样式要修改
  (setq oldstatus (reverse oldstatus))
)

(defun dyq-put-oldstatus (oldstatus) ;还原系统原系统变量
  (setq num (length oldstatus))
  (setq i 1)
  (repeat (/ (- num 1) 2)
    (setvar (nth i oldstatus) (nth (+ i 1) oldstatus))
    (setq i (+ i 2))
  )
)

  ;获得文字的宽度
(defun dyq-get-string-netwide (obj / objlist minp maxp ang) ;文字净宽
  (setq objlist (entget obj))
  (setq ang (cdr (assoc '50 objlist)))
  (setq objlist (subst '(50 . 0) (assoc '50 objlist) objlist))
  (entmod objlist)
  (setq objinsertpnt (cdr (assoc '10 objlist)))
  (vla-getboundingbox
    (vlax-ename->vla-object obj)
    'minp
    'maxp
  )
  (setq minp (vlax-safearray->list minp))
  (setq maxp (vlax-safearray->list maxp))
  (setq objlist (subst (cons 50 ang) (assoc '50 objlist) objlist))
  (entmod objlist)
  (- (car maxp) (car minp))
)

(princ "\nzx  文字加下划线")
(defun c:zx (/ xz num i obj minp maxp x1 y1 x2 y2 txtang txtpoint oldlayer shenchu gaptextline)
  (setq &olderr& *error*)
  (setq *error* *$dyq-error$*)
  (setq oldstatus (dyq-get-oldstatus))
  (dyq-new-layer "T图名" 6)
  (setvar "clayer" "T图名")
  (setvar "OSMODE" 0)
  (setq zxfilename "c:/zx.txt")
  (if (findfile zxfilename)
    (progn
      (setq f (open zxfilename "r"))
      (if (setq numline (read-line f))
 (setq numline (atoi numline))
 (progn
   (setq numline 1)
 )
      )
      (close f)
    )
    (setq numline 1)
  )
  (setq oldnumline numline)
  (if (setq numline (getint (strcat "\n[单下划线(1)/双下划线(2)]<"
        (itoa numline)
        ">:"
       )
      )
      )
    ()
    (setq numline oldnumline)
  )
  ;保存到数据文件
  (setq f (open zxfilename "w"))
  (write-line (itoa numline) f)
  (close f)

  (setq shenchu 200) ;直线伸出的长度
  (setq gaptextline 200) ;文字与直线的间距
  (setq gapline 100) ;双下划线间距
  (setq biglinewide 70) ;下划线粗线线宽
  (setq smalllinewide 0) ;下划线细线线宽
  (if (setq xz (ssget '((0 . "*TEXT,LWPOLYLINE,LINE"))))
    (progn
      (setq xzline (ssget "x" '((0 . "LWPOLYLINE,LINE"))))
      (setq xzline (dyq-get-jiaoji xz xzline))
      (setq xztext (dyq-get-chaji xz xzline))
      (command "erase" xzline "")
      (setq num (sslength xztext))
      (setq i 0)
      (repeat num
 (setq obj (ssname xztext i))
 (setq objlist (entget obj))
 (setq txtang (cdr (assoc '50 objlist)))
 (setq pt (cdr (assoc '10 objlist)))
 (setq txtlen (dyq-get-string-netwide obj))
 (setq p1 (polar (polar pt (- txtang (* 0.5 pi)) gaptextline)
   (+ txtang pi)
   shenchu
   )
 )
 (setq p2 (polar p1 (- txtang (* 0.5 pi)) gapline))
 (command "pline" ;如果是单下划线则绘制细线
   p1
   "w"
   biglinewide
   biglinewide
   (polar p1 txtang (+ shenchu shenchu txtlen))
   ""
 )
 (if (= numline 2.0) ;如果是双下划线则绘制细线
   (command "pline"
     p2
     "w"
     smalllinewide
     smalllinewide
     (polar p2 txtang (+ shenchu shenchu txtlen))
     ""
   )
 )
 (setq i (+ i 1))
      )
    )
  )

  (dyq-put-oldstatus oldstatus)
  (setq *error* &olderr&)
  (princ)
) ;zx结束

flfcegu168

这是删直线程式：

(defun c:sx()
  (prompt "/n 请选择要删除的直线")
  (setq s2 (ssget
     (list (cons -4 "<or")(cons 0 "line")
                         (cons -4 "or>")
            )));;选择物体。
  (if (= s2 nil)(exit))
  (setq index 0)

  (command "erase" s2 "")
  (prin1)
  )