请大侠帮忙

yu-gn

求大侠为小弟编一程序实现
根据条件摘取text
1.读取数据文件为条件直线，摘取靠近直线一定范围内的文字。如：文字到直线垂距5范围内的文字（如a所示范围外的为红色文字，内为黄色文字）
2.生成文本格式如生成文件所示

zhuqi75

完全可以的！

meflying

你的目的是不是从数据文件读出直线，再找到该直线附近的点，然后输出该点及到该直线顶端的沿直线方向的距离？
是否急要？

yu-gn

meflying

yu-gn

龙龙仔

;;文字到直线垂距5范围内的文字,这句话有点不清楚
;;垂距的定义是甚么??是文字插入点吗?
;;文字插入点可不大好处理!!!

;;只写出一个简陋程序

;;1.欠从数据文件读出直线
;;2.欠最近点排序
;;3.直线顶端的沿直线方向判定(ent10 or ent11)
;;4.欠写出档案
;;5.还欠很多...........Sorry

;;usage: (tt 5)
(defun TT (D           /           HOLDOSMODE           QQQ           ENT           ENT10
           ENT11   ENTANG  ENTDIST PT1           PT2           PT3           PT4
           SS
          )

  ;;摘取靠近直线一定范围内的文字
  (defun SET_BOX (ENT1 D)
    (setq _PI2 (/ pi 2.0))
    (setq ENT10 (DXF 10 ENT1))
    (setq ENT11 (DXF 11 ENT1))
    (setq ENTANG (angle ENT10 ENT11))
    (setq ENTDIST (distance ENT10 ENT11))
    (setq PT1 (polar ENT10 (+ _PI2 ENTANG) D))
    (setq PT2 (polar PT1 ENTANG ENTDIST))
    (setq PT3 (polar PT2 (- ENTANG _PI2) (* D 2.0)))
    (setq PT4 (polar ENT10 (- ENTANG _PI2) D))
    (setq SS (ssget "cp" (list PT1 PT2 PT3 PT4) '((0 . "text"))))
    SS
  )

  (defun DXF (A1 A2)
    (cdr (assoc A1 (entget A2)))
  )

  ;;文字插入点与直线最近点
  (defun PTLIST        (SS ENT1 / PLIST N)
    (setq ENT1 (vlax-ename->vla-object ENT1))
    (setq N 0)
    (repeat (sslength SS)
      (setq ENT (vlax-ename->vla-object (ssname SS N)))
      (setq PLIST (append PLIST
                          (list        (vlax-curve-getclosestpointto
                                  ENT1
                                  (vlax-safearray->list
                                    (vlax-variant-value
                                      (vla-get-insertionpoint ENT)
                                    )
                                  )
                                )
                          )
                  )
      )
      (setq N (1+ N))
    )
    PLIST
  )

  (setq HOLDOSMODE (getvar "osmode"))
  (setvar "osmode" 0)
  (setq SS (SET_BOX (setq ENT1 (car (entsel "\n选直线: "))) D))                                        ;直线偏移5范围内的文字
  (setq QQQ (PTLIST SS ENT1))
  (command "_.dimaligned"
           ENT10
           (nth 0 QQQ)
           (polar ENT10 (+ _PI2 ENTANG) (* D 2.0))
  )
  (command "_.dimbaseline")
  (setq QQQ (cdr QQQ))
  (setq N 0)
  (repeat (length QQQ)
    (command (nth N QQQ))
    (setq N (1+ N))
  )
  (command)
  (setvar "osmode" HOLDOSMODE)
  (princ)
)

yu-gn

是文字的插入点到直线的距离

龙龙仔

;;文字到直线垂距5范围内的文字,这句话有点不清楚
;;垂距的定义是甚么??是文字插入点吗?
;;文字插入点可不大好处理!!!
;;框选文字本身程序如下!!!

;;USAGETT <范围>)
;;USAGETT 5)
(defun TT (D / FF GG AA CURRENT_LINE QQ PT1 PT2)
  (command "_.undo" "group")
  (command "_.zoom" "e")
  (setq FF (findfile "数据文件.TXT"))
  (setq        GG (open (strcat (vl-filename-directory FF) "\\生成檔.TXT")
                 "w"
           )
  )
  (write-line "标号        距离        读数" GG)
  (if (setq FF (open FF "r"))
    (progn
      (setq CURRENT_LINE (read-line FF))
      (while (setq CURRENT_LINE (read-line FF))
        (setq AA (PARSE CURRENT_LINE ","))
        (setq PT1 (list (read (nth 1 AA)) (read (nth 2 AA))))
        (setq PT2 (list (read (nth 3 AA)) (read (nth 4 AA))))
        (if (/= (cadr PT1) (cadr PT2))
          (setq        QQ (vl-sort (list PT1 PT2)
                            (function (lambda (P1 P2)
                                        (> (cadr P1) (cadr P2))
                                      )
                            )
                   )
          )
          (setq        QQ (vl-sort (list PT1 PT2)
                            (function (lambda (P1 P2)
                                        (< (car P1) (car P2))
                                      )
                            )
                   )
          )
        )
        (command
          "_.line"
          (car QQ)
          (cadr QQ)
          ""
        )
        (TTT (entlast) D)
        (command "text"
                 "j"
                 "m"
                 (polar (car QQ) (angle (cadr QQ) (car QQ)) 5)
                 "5"
                 ""
                 (nth 0 AA)
        )
      )
    )
  )
  (close FF)
  (close GG)
  (command "_.zoom" "p")
  (command "_.undo" "end")
  (print)
)

(defun PARSE (STR DELIM / LST POS)
  (setq POS (vl-string-search DELIM STR))
  (while POS
    (setq LST (cons (substr STR 1 POS) LST)
          STR (substr STR (+ POS 2))
          POS (vl-string-search DELIM STR)
    )
  )
  (if (> (strlen STR) 0)
    (setq LST (cons STR LST))
  )
  (reverse LST)
)

(defun TTT (ENT1 D / HOLDOSMODE QQQ ENT ENTANG SS)

  ;;摘取靠近直线一定范围内的文字
  (defun SET_BOX (ENT1 D / ENT10 ENT11 ENTDIST PT1 PT2 PT3 PT4 SS)
    (setq _PI2 (/ pi 2.0))
    (setq ENT10 (DXF 10 ENT1))
    (setq ENT11 (DXF 11 ENT1))
    (setq ENTANG (angle ENT10 ENT11))
    (setq ENTDIST (distance ENT10 ENT11))
    (setq PT1 (polar ENT10 (+ _PI2 ENTANG) D))
    (setq PT2 (polar PT1 ENTANG ENTDIST))
    (setq PT3 (polar PT2 (- ENTANG _PI2) (* D 2.0)))
    (setq PT4 (polar ENT10 (- ENTANG _PI2) D))
    (setq SS (ssget "cp" (list PT1 PT2 PT3 PT4) '((0 . "text"))))
    SS
  )

  (defun DXF (A1 A2)
    (cdr (assoc A1 (entget A2)))
  )

  ;;文字插入点与直线最近点
  (defun PTLIST        (SS ENT1 / PP PLIST N)
    (setq ENT1 (vlax-ename->vla-object ENT1))
    (setq N 0)
    (repeat (sslength SS)
      (setq ENT (vlax-ename->vla-object (ssname SS N)))
      (setq PP (vlax-safearray->list
                 (vlax-variant-value
                   (vla-get-insertionpoint ENT)
                 )
               )
      )
      (setq PLIST (append PLIST
                          (list        (list (vlax-curve-getclosestpointto
                                        ENT1
                                        PP
                                      )
                                      (vla-get-textstring ENT)
                                )
                          )
                  )
      )
      (setq N (1+ N))
    )
    PLIST
  )

  (setq HOLDOSMODE (getvar "osmode"))
  (setvar "osmode" 0)
  (if (setq SS (SET_BOX ENT1 D))
    (progn
      (if (/= (cadr PT1) (cadr PT2))
        (setq
          QQQ (reverse (vl-sort        (PTLIST SS ENT1)
                                (function (lambda (P1 P2)
                                            (< (cadar P1) (cadar P2))
                                          )
                                )
                       )
              )
        )
        (setq
          QQQ (vl-sort (PTLIST SS ENT1)
                       (function (lambda (P1 P2)
                                   (< (cadar P1) (cadar P2))
                                 )
                       )
              )
        )
      )

      ;;写出档案
      ;;----------------------------------------------
      (write-line
        (strcat        (nth 0 AA)
                "        "
                (rtos (distance (car QQ) (car (nth 0 QQQ))) 2 2)
                "        "
                (cadr (nth 0 QQQ))
        )
        GG
      )
      (setq N 1)
      (repeat (- (length QQQ) 1)
        (write-line
          (strcat "        "
                  (rtos (distance (car QQ) (car (nth N QQQ))) 2 2)
                  "        "
                  (cadr (nth N QQQ))
          )
          GG
        )
        (setq N (1+ N))
      )
      ;;------------------------------------------------

      ;|     
      ;;尺寸标注
      ;;------------------------------------------------
      (command "_.dimaligned"
               (car QQ)
               (car (nth 0 QQQ))
               (polar (car QQ) (+ _PI2 ENTANG) (* D 2.0))
      )
      (command "_.dimbaseline")
      (setq QQQ (cdr QQQ))
      (setq N 0)
      (repeat (length QQQ)
        (command (car (nth N QQQ)))
        (setq N (1+ N))
      )
      (command)
      |;
      ;;-------------------------------------------------

    )
  )
  (setvar "osmode" HOLDOSMODE)
  (princ)
)