zzmm 发表于 2013-1-15 11:29:41

点选标注 复制标注 按指定点移动标注并画线 ？？？→圆弧 符号的提取

(defun c:tbx()(setvar "cmdecho" 0)(setq oldos (getvar "osmode"))(setvar "osmode" 0)(setq e (entsel "\n**选择标注:"))(setq en (car e))(start_getss)(command "copy" en "" "0,0" "0,0"         "explode" (entlast))(setq ss (getdrawss))(setq i 0)(repeat (if ss (sslength ss) 0)    (setq en0 (ssname ss i))    (setq typ (cdr (assoc 0 (entget en0))))    (if (= "MTEXT" typ)              (setq mtext0 en0)      (entdel en0)    )    (setq i (+ i 1))) (setq pt (cdr (assoc 10 (entget mtext0)))       hh (cdr (assoc 40 (entget mtext0)))       ww (cdr (assoc 42 (entget mtext0)))       rot (cdr (assoc 50 (entget mtext0))) ) (setq p0 (polar pt (+ rot (* pi 1.5)) (* hh 0.5))) (setq p1 (polar p0 (+ rot pi) (* ww 0.5)))(setq pt1 (getpoint "\n选择文字插入点:"))   (command "move" mtext0 "" p1 pt1)   ;(entdel en0)(command "-layer" "m" "dim" "c" 3 "dim" "")   (setq pt2 (polar pt1 (+ rot(* pi 0.5)) (* hh 0.2))         pt3 (polar pt2 (+ rot pi) (* hh 0.1))         pt4 (polar pt2 rot (+ ww 0.7))   )   (command "line" pt3 pt4 "")   (setq pt5 (polar pt1 (+ rot(* pi 0.5)) (* hh 0.8))         pt6 (polar pt5 (+ rot pi) (* hh 0.1))         pt7 (polar pt5 rot (+ ww 0.7))   )   (command "line" pt6 pt7 "")(command "layer" "s" "0" "")(setvar "osmode" oldos)(setvar "cmdecho" 0)(princ))(defun start_getss ()(setq StartEnt (entlast)))(defun getdrawss ()(if StartEnt    (progn      (setq Draw_SS (ssadd))      (setq ssss_en StartEnt)      (while (setq ssss_en (entnext ssss_en))        (setq Draw_entype (cdr (assoc 0 (entget ssss_en))))        (if (and (/= (strcase Draw_entype) "ATTRIB")               (/= (strcase Draw_entype) "SEQEND")          )          (setq Draw_SS (ssadd ssss_en Draw_SS))        )      )    )    (setq Draw_SS (ssget "_x")))Draw_SS)这行代码是选择标注炸开   原点复制 去提取标注文字根据指定点进行移动 并画线
但是碰到圆弧标注的时候 就提取不出来了 应为炸开圆弧标注 有两个或者4个圆弧
怎样才能把用红圈框起来的圆弧提取出来并移动到相应的位置
                  
想做出的效果图


烦请各位版主帮帮忙   更改一下代码感激不敬

zzmm 发表于 2013-1-15 11:30:57

(defun c:tbx()
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq e (entsel "\n**选择标注:"))
(setq en (car e))
(start_getss)
(command "copy" en "" "0,0" "0,0"
         "explode" (entlast))
(setq ss (getdrawss))
(setq i 0)
(repeat (if ss (sslength ss) 0)
    (setq en0 (ssname ss i))
    (setq typ (cdr (assoc 0 (entget en0))))
    (if (= "MTEXT" typ)       
      (setq mtext0 en0)
      (entdel en0)
    )
    (setq i (+ i 1))
)
(setq pt (cdr (assoc 10 (entget mtext0)))
       hh (cdr (assoc 40 (entget mtext0)))
       ww (cdr (assoc 42 (entget mtext0)))
       rot (cdr (assoc 50 (entget mtext0)))
)
(setq p0 (polar pt (+ rot (* pi 1.5)) (* hh 0.5)))
(setq p1 (polar p0 (+ rot pi) (* ww 0.5)))
(setq pt1 (getpoint "\n选择文字插入点:"))
   (command "move" mtext0 "" p1 pt1)
   ;(entdel en0)
(command "-layer" "m" "dim" "c" 3 "dim" "")
   (setq pt2 (polar pt1 (+ rot(* pi 0.5)) (* hh 0.2))
         pt3 (polar pt2 (+ rot pi) (* hh 0.1))
         pt4 (polar pt2 rot (+ ww 0.7))
   )
   (command "line" pt3 pt4 "")
   (setq pt5 (polar pt1 (+ rot(* pi 0.5)) (* hh 0.8))
         pt6 (polar pt5 (+ rot pi) (* hh 0.1))
         pt7 (polar pt5 rot (+ ww 0.7))
   )
   (command "line" pt6 pt7 "")
(command "layer" "s" "0" "")
(setvar "osmode" oldos)
(setvar "cmdecho" 0)
(princ)
)

(defun start_getss ()
(setq StartEnt (entlast))
)


(defun getdrawss ()
(if StartEnt
    (progn
      (setq Draw_SS (ssadd))
      (setq ssss_en StartEnt)
      (while (setq ssss_en (entnext ssss_en))
        (setq Draw_entype (cdr (assoc 0 (entget ssss_en))))
        (if (and (/= (strcase Draw_entype) "ATTRIB")
               (/= (strcase Draw_entype) "SEQEND")
          )
          (setq Draw_SS (ssadd ssss_en Draw_SS))
        )
      )
    )
    (setq Draw_SS (ssget "_x"))
)
Draw_SS
)

xiabin68 发表于 2013-1-15 13:02:54

楼历害哦，，，，，
页: [1]
查看完整版本: 点选标注 复制标注 按指定点移动标注并画线 ？？？→圆弧 符号的提取