[求助]请编一个将通过文字区的线剪断的程序

zhang8755 · 发表于 2004-1-8 19:17:00

在地形图中有许多等高线和高程标注，请大虾编一个将通过文字区的等高线剪断的程序
zhang8755 附带了这个的图片 :

bemg31kmtnu.jpg

efan2000 · 发表于 2004-1-8 20:15:00

在ET扩展工具—文本工具—文本屏蔽就是实现这个功能的。

BDYCAD · 发表于 2004-1-8 20:15:00

這個不難．　我試試．
(defun c:test(/ os st textp one tow three four)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 1)
  (setq st(ssget '((0 . "TEXT"))))
  (command "ucs" "ob"(SSNAME ST 0) )
  (SETQ TEXTP (textbox (ENTGET (SSNAME ST 0))))
  (setq one (car textp) tow (cadr textp))
  (setq three (polar one 0 (car tow)))
  (setq four (polar one (/ pi 2.0) (cadr tow)))
  (command "trim" "all" ""  "f"one three tow four """")
  (command "ucs" "")
  (setvar "osmode" os) (setvar "cmdecho" 1)
  (princ))

BDYCAD · 发表于 2004-1-8 20:28:00

再完善點．　我認為這樣就比較好了．　
(defun c:test (/ os st i textp one tow three four)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 1)
  (setq st (ssget '((0 . "TEXT"))))
  (setq i 0)
  (repeat (sslength st)
(command "ucs" "ob" (SSNAME ST i))
(SETQ textp (textbox (ENTGET (SSNAME ST 0))))
(setq one (car textp)
      tow (cadr textp)
)
(setq three (polar one 0 (car tow)))
(setq four (polar one (/ pi 2.0) (cadr tow)))
(command "trim" "all" "" "f" one three tow four "" "")
(command ".erase" "f" one tow"" "r"(SSNAME ST i) "")
(command ".erase" "f" three four """r" (SSNAME ST i)"")
(command "ucs" "")
(setq i (1+ i))
  )
  (setvar "osmode" os)
  (setvar "cmdecho" 1)
  (princ)
)

wb0815 · 发表于 2004-1-8 22:02:00

第4楼的同志做的不错嘛
我一前些过一个可是好长的
你的简单多了
不错

congcong · 发表于 2004-1-9 07:37:00

还可以再改进，而且当线在文字领域内交叉时，剪出来的就不太好了。

congcong · 发表于 2004-1-9 08:46:00

刚刚改好的，看看这个怎么样。
谁能改一下，让它能剪切标注文本上的线。
(defun c:testtrim (/ os st i textp one two three four)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 1)
  (setq st (ssget '((0 . "TEXT"))))
  (setq i 0)

  (repeat (sslength st)
(vl-cmdf "ucs" "ob" (ssname st i))
(SETQ textp (textbox (ENTGET (SSNAME ST 0))))
(setq one (car  textp)
      two (cadr textp)
)
(setq three (polar one 0 (car two)))
(setq four  (polar one (/ pi 2.0) (cadr two)))
(command "trim" "" "f" one three  "" ""
         "trim" "" "f" two four "" ""
         "trim" "" "f" one four "" ""
         "trim" "" "f" two three  "" "")
(command ".erase" "cp" one three two four "" "r" (SSNAME ST i) "")
(command "ucs" "")
(setq i (1+ i))
  );end repeat

  (setvar "osmode" os)
  (setvar "cmdecho" 1)
  (vl-cmdf "ucs" "")
  (princ)
)

zhang8755 · 发表于 2004-1-9 11:50:00

谢谢4楼的和7楼的

cqnj023 · 发表于 2004-1-9 12:11:00

4楼和7楼的程序采用了不同的剪切方式，产生了不同的效果，经测试，结果有部分不理想，4楼的甚至丢了一半线条，从程序来看不应该出现这种情况，（如图,desktop.rar文件中），不知问题出在哪里？
贴一个在et命令下修改的代码，可选择剪切边界距文字（text及mtext，会清除mtext的文字框大于文字长度的部分）的距离，并删除文字处的不需要实体，以使文字清楚显现。

copy


(defun c:texttrim (     )
  (defun ucs_2_mtext (ENT / PT)
    (setq PT (cdr (assoc 210 (entget ENT)))
          PT (strcat "*"
               (rtos (car PT) 2 8) ","
               (rtos (cadr PT) 2 8) ","
               (rtos (caddr PT) 2 8)
             );setq
    (command "_.ucs" "_za" "*0.0,0.0,0.0" PT)
    (command "_.ucs" "_or" (trans (cdr (assoc 10 (entget ENT))) 0 1))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun mtextbox (MTXT / WDTH HGHT INS JUST ANG P1 P2 P3 P4)
    (if (and (listp MTXT) (= "MTEXT" (cdr (assoc 0 MTXT))))
      (progn
        (setq WDTH (cdr (assoc 42 MTXT))
              HGHT (cdr (assoc 43 MTXT))
              INS  (trans (cdr (assoc 10 MTXT)) 0 1)
              JUST (cdr (assoc 71 MTXT))
              ANG  (cdr (assoc 50 MTXT))
        )
        (cond
          ((= JUST 1)
            (setq P1 (polar INS (- ANG (* Pi 0.5)) HGHT) 
                  P2 (polar P1 ANG WDTH)                 
                  P3 (polar INS ANG WDTH)                
                  p4 INS                                 
            )
          )
          ((= JUST 2)
            (setq P3 (polar INS ANG (/ WDTH 2))
                  P4 (polar INS (+ ANG Pi) (/ WDTH 2))
                  P1 (polar P4 (- ANG (* Pi 0.5)) HGHT)
                  P2 (polar P1 ANG WDTH)
            )
          )
          ((= JUST 3)
            (setq P3 INS
                  P4 (polar INS (+ ANG Pi) WDTH)
                  P1 (polar P4 (- ANG (* Pi 0.5)) HGHT)
                  P2 (polar P1 ANG WDTH)
            )
          )
          ((= JUST 4)
            (setq P4 (polar INS (+ ANG (* Pi 0.5)) (/ HGHT 2))
                  P3 (polar P4 ANG WDTH)
                  P1 (polar P4 (- ANG (* Pi 0.5)) HGHT)
                  P2 (polar P1 ANG WDTH)
            )
          )
          ((= JUST 5)
            (setq P4 (polar INS (- ANG Pi) (/ WDTH 2))
                  P4 (polar P4 (+ ANG (* Pi 0.5)) (/ HGHT 2))
                  P3 (polar P4 ANG WDTH)
                  P1 (polar P4 (- ANG (* Pi 0.5)) HGHT)
                  P2 (polar P1 ANG WDTH)
            )
          )
          ((= JUST 6)
            (setq P3 (polar INS (+ ANG (* Pi 0.5)) (/ HGHT 2))
                  P4 (polar P3 (+ ANG Pi) WDTH)
                  P1 (polar P4 (- ANG (* Pi 0.5)) HGHT)
                  P2 (polar P1 ANG WDTH)
            )
          )
          ((= JUST 7)
            (setq P1 INS
                  P2 (polar P1 ANG WDTH)
                  P3 (polar P2 (+ ANG (* Pi 0.5)) HGHT)
                  P4 (polar P1 (+ ANG (* Pi 0.5)) HGHT)
            )
          )
          ((= JUST 8)
            (setq P1 (polar INS (+ ANG Pi) (/ WDTH 2))
                  P2 (polar P1 ANG WDTH)
                  P3 (polar P2 (+ ANG (* Pi 0.5)) HGHT)
                  P4 (polar P1 (+ ANG (* Pi 0.5)) HGHT)
            )
          )
          ((= JUST 9)
            (setq P2 INS
                  P1 (polar INS (+ ANG Pi) WDTH)
                  P3 (polar P2 (+ ANG (* Pi 0.5)) HGHT)
                  P4 (polar P1 (+ ANG (* Pi 0.5)) HGHT)
            )
          )
        )
      )
      (prompt "\nEntity Not Mtext!")
    )
    (list P1 P2 P3 P4)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun drawbox (TXT DIST / TBX PT ORGBND)
    (if (= TXTYP "TEXT")
      (progn
        (setq TBX (textbox TXT))    ; normal text
        (setq dian1 (car TBX))
        (setq dian2 (list (caadr TBX)(cadar TBX)))        
        (setq dian3 (cadr TBX))
        (setq dian4 (list (caar TBX)(cadadr TBX)))
        (command "_.pline" (car TBX) (list (caadr TBX)(cadar TBX))
                 (cadr TBX) (list (caar TBX)(cadadr TBX)) "_close"
        )
      )
      (progn
        (setq TBX (mtextbox TXT))   ; Mtext
        (setq dian1 (car TBX))
        (setq dian2 (cadr TBX))        
        (setq dian3 (caddr TBX))
        (setq dian4 (cadddr TBX))
        (command "_.pline")
        (foreach PT TBX (command PT))
        (command "_c")
      )
    )
    (setq ORGBND (entlast))
    (command "_.offset" DIST (entlast))
    (if (= TXTYP "TEXT")
      (command "-1,-1" "")
       (command (polar 
                 (cdr (assoc 10 TXT))
                 (cdr (assoc 50 TXT))
                 (* 2 (cdr (assoc 42 TXT)))
               )
               ""
        )
     )    
    (entdel ORGBND)
 (list dian1 dian2 dian3 dian4)
  );end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
            (setvar "osmode" 0) 
      (setq CNT   0                                   
            EA   "Y"
            FLTR   '( (-4 . "")
                    )
      )
  (SETQ EA (getstring "\n\n删除文字所压实体? （N） ："))
; ------------------ Set the offset value to use ----------------- 
    
      (setq OSET (getcfg "AppData/AC_Bonus/Txtmsk_Offset"))
      (if (not (and OSET
                (= (type (setq OSET (read OSET))) 'REAL) 
               )
          )
        (setq OSET 0.35 )                              ; use 0.35 as default.
      )
          
      (initget 4)                                      ; No negative values allowed
      (setq TMP
        (getdist (strcat "\n输入偏移比例：（应大于0） : "))
      )
      (if TMP (setq OSET TMP))
      (setcfg "AppData/AC_Bonus/Txtmsk_Offset" (rtos OSET 2 2))
; ---------------------- get text to mask ------------------------
      (Princ "\n选择文字以便进行压线剪切或删除文字所压实体：")
      
      (setq SS (ssget FLTR))                       
; ----------------- Step through each and mask -------------------
          (While (setq ENT (ssname SS CNT))           
            
            (setq TXT   (entget ENT (list "*"))
                  txt2 (entget ent)
            TXTYP (cdr (assoc 0 TXT))            
            )
            (if (= TXTYP "TEXT")
              (command "_.ucs" "_object" ENT)       
               (ucs_2_mtext ENT)
             )
            (setq  TOS (* (cdr (assoc 40 TXT)) OSET)    
            )
            (drawbox TXT TOS)                          
            (setq box2 (entlast))
  
    (command "trim" "last" "" "f" dian1 dian2 dian3 dian4  dian1 "" "")
    (command "trim" "last" "" "f" dian1 dian2 dian3 dian4  dian1 "" "")
    (IF (OR (= EA "y") (= EA "Y"))
    (command "erase" "wp" dian1 dian2 dian3 dian4 "" ""))
            (entdel box2)
              (command "_.ucs" "_previous")              
  
            (if (= TXTYP "MTEXT")
              (command "_.ucs" "_previous")       
            )
            
            (setq CNT (1+ CNT))                       
          ); while
)
)