自动坐标问题点需要优化，请高手指点；

tang87

命令过后，对象捕捉就全部空选了。请大家帮助解决下。感谢

(defun C:bzx (/ chanshu001 ent ent1 i lst_1 lst_2 lst_3 lst_4 lst_pt lst_x lst_y lstlx lstly lstx1
               lstx2 lsty1 lsty2 p001 p002 p003 p004 pmax pmay pminx pminy pt0 pt0linshijidian pzhx
               pzhxl pzhy pzhyl sc snap ss ssguol uuu x_last xlins xxxx xzuih xzuihbak xzuihbak2
               y_last ylins yyyy yzuih yzuihbak2 yzuihbak3 xsw
            )
  (setvar "cmdecho" 0)                 ; 关闭命令响应
  (setq ss (ssget '((0 . "LINE,CIRCLE,PLINE,LWPOLYLINE,INSERT"))))
  (setq PT0linshijidian '(0.0 0.0 0.0))
  (setq PT0 (getpoint "\n指定基点: "))
  (cond
    ((null PT0)
      (setq PT0 PT0linshijidian)
    )
    ((= PT0 0.0)
      (setq PT0 PT0linshijidian)
    )
  )
  (setq SC 1)
  (setq SC (getreal "\n输入比例 <1>: "))
  (cond
    ((null SC)
      (setq SC 1)
    )
    ((= uuu 0.0)
      (setq SC 1)
    )
  )
  (setq chanshu001 (* 7 (getvar "dimtxt") (getvar "dimscale")))
  (setq uuu (atof (getstring (strcat "\n标注拉伸 <" (rtos chanshu001) ">:"))))
  (cond
    ((null uuu)
      (setq uuu chanshu001)
    )
    ((= uuu 0.0)
      (setq uuu chanshu001)
    )
  )                                    ; 下面程序设置过滤虚线条件
  (setq ssguol '("ACAD_ISO03W100" "ACAD_ISO02W100"
         "DASHED" "DASHED2"
         "DASHEDX2" "HIDDEN"
         "HIDDEN2" "HIDDENX2"
        )
  )                                    ; 下面程序将虚线图层加入虚线过滤条件
  (setq ssguol (append
                 SSguol
                 (TT-01 "ACAD_ISO03W100")
                 (TT-01 "ACAD_ISO02W100")
                 (TT-01 "DASHED")
                 (TT-01 "DASHED2")
                 (TT-01 "DASHEDX2")
                 (TT-01 "HIDDEN")
                 (TT-01 "HIDDEN2")
                 (TT-01 "HIDDENX2")
               )
  )                                    ; 下面程序将选择集中随层的虚线图层中的线过滤掉
  (SETQ i 0)
  (while (< i (sslength ss))
    (setq ent (ssname ss i))
    (setq ent1 (entget ent))
    (if (and
          (member (cdr (assoc 8 ent1)) ssguol)
          (/= (cdr (assoc 0 ent1)) "INSERT")
          (= (assoc 6 ent1) nil)
        )
      (setq ss (ssdel ent ss))
      (SETQ i (+ 1 i))
    )
  )                                    ; 下面程序将选择集中其他层的虚线图元过滤掉
  (SETQ i 0)
  (while (< i (sslength ss))
    (setq ent (ssname ss i))
    (setq ent1 (entget ent))
    (if (member (cdr (assoc 6 ent1)) ssguol)
      (setq ss (ssdel ent ss))
      (SETQ i (+ 1 i))
    )
  )                                    ; 主要程序
  (vl-cmdf ".UNDO" "BE")               ; 设置UNDO起点
  (setq snap (getvar "osmode"))
  (setvar "osmode" 0)                  ; 关闭捕捉
  (setq xsw (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)                  ; 关闭小数点末尾数为0时候省略
  (progn
    (setq LST_PT (TT-02 ss))
    (setq LST_PT (cons PT0 LST_PT))    ; 下面程序坐标分象限
    (setq i 1
          pminx (car (nth 0 LST_PT))
          pmax pminx
          pminy (cadr (nth 0 LST_PT))
          pmay pminy
    )
    (while (<= i (length LST_PT))
      (setq xxxx (car (nth (- i 1) LST_PT)))
      (setq yyyy (cadr (nth (- i 1) LST_PT)))
      (cond
        ((< xxxx pminx)
          (setq pminx xxxx)
        )
        ((> xxxx pmax)
          (setq pmax xxxx)
        )
        ((< yyyy pminy)
          (setq pminy yyyy)
        )
        ((> yyyy pmay)
          (setq pmay yyyy)
        )
        (t
          (princ)
        )
      )
      (setq i (+ i 1))
    )                                  ; 求坐标范围中间数值
    (setq pzhx (/ (+ pminx pmax) 2))
    (setq pzhy (/ (+ pminy pmay) 2))   ; 求4个象限的坐标对齐点
    (setq p001 (list (- pminx uuu) (- pminy uuu) 0.0)
          p002 (list (- pminx uuu) (+ pmay uuu) 0.0)
          p003 (list (+ pmax uuu) (- pminy uuu) 0.0)
          p004 (list (+ pmax uuu) (+ pmay uuu) 0.0)
    )                                  ; 将坐标分类到四个象限
    (setq i 0
          LST_1 '()
          LST_2 '()
          LST_3 '()
          LST_4 '()
    )
    (while (< i (length LST_PT))
      (setq pzhxl (car (nth i LST_PT))
            pzhyl (cadr (nth i LST_PT))
      )
      (if (and
            (<= pzhxl pzhx)
            (<= pzhyl pzhy)
          )
        (setq LST_1 (cons (nth i LST_PT) LST_1))
      )
      (if (and
            (<= pzhxl pzhx)
            (> pzhyl pzhy)
          )
        (setq LST_2 (cons (nth i LST_PT) LST_2))
      )
      (if (and
            (> pzhxl pzhx)
            (<= pzhyl pzhy)
          )
        (setq LST_3 (cons (nth i LST_PT) LST_3))
      )
      (if (and
            (> pzhxl pzhx)
            (> pzhyl pzhy)
          )
        (setq LST_4 (cons (nth i LST_PT) LST_4))
      )
      (setq i (+ i 1))
    )                                  ; 坐标分象限结束
    (setq Xlins '(0.0)
          Ylins '(0.0)
    )
    (setq LSTX1 '()
          LSTX2 '()
          LSTY1 '()
          LSTY2 '()
    )
    (setq LST_X (TT-03 LST_1)
          LST_Y (TT-04 LST_1)
    )
    (setq LST_X (TT-10 SS LST_X)
          LST_Y (TT-11 SS LST_Y)
    )
    (setq X_LAST (caar LST_X))
    (setq Y_LAST (caar LST_Y))
    (TT-07 LST_X LST_Y PT0 SC p001)
    (setq LSTX1 (append
                  LSTX1
                  (reverse LSTLX)
                )
    )
    (setq LSTY1 (append
                  LSTY1
                  (reverse LSTLY)
                )
    )
    (setq Xzuihbak Xzuih)
    (setq LST_X (TT-05 LST_2)
          LST_Y (TT-04 LST_2)
    )
    (setq LST_X (TT-10 SS LST_X)
          LST_Y (TT-11 SS LST_Y)
    )
    (setq X_LAST (caar LST_X))
    (TT-07 LST_X LST_Y PT0 SC p002)
    (setq LSTX2 (append
                  LSTX2
                  (reverse LSTLX)
                )
    )
    (setq LSTY1 (append
                  LSTY1
                  (reverse LSTLY)
                )
    )
    (setq Xzuihbak2 Xzuih)
    (setq Yzuihbak2 Yzuih)
    (setq LST_X (TT-03 LST_3)
          LST_Y (TT-06 LST_3)
    )
    (setq LST_X (TT-10 SS LST_X)
          LST_Y (TT-11 SS LST_Y)
    )
    (setq X_LAST Xzuihbak)
    (setq Y_LAST (caar LST_Y))
    (TT-07 LST_X LST_Y PT0 SC p003)
    (setq LSTX1 (append
                  LSTX1
                  (reverse LSTLX)
                )
    )
    (setq LSTY2 (append
                  LSTY2
                  (reverse LSTLY)
                )
    )
    (setq Yzuihbak3 Yzuih)
    (setq X_LAST Xzuihbak2)
    (setq LST_X (TT-05 LST_4)
          LST_Y (TT-06 LST_4)
    )
    (if (= Yzuihbak2 Yzuihbak3)
      (setq Y_LAST (caar LST_Y))
      (setq Y_LAST Yzuihbak3)
    )
    (setq LST_X (TT-10 SS LST_X)
          LST_Y (TT-11 SS LST_Y)
    )
    (TT-07 LST_X LST_Y PT0 SC p004)
    (setq LSTX2 (append
                  LSTX2
                  (reverse LSTLX)
                )
    )
    (setq LSTY2 (append
                  LSTY2
                  (reverse LSTLY)
                )
    )
  )
  (TT-12 LSTX1 PT0)
  (TT-13 LSTY1 PT0)
  (TT-12 LSTX2 PT0)
  (TT-13 LSTY2 PT0)
  (vl-cmdf ".UNDO" "E")                ; 设置UNDO终点
  (setvar "osmode" snap)
  (setvar "DIMZIN" xsw)
  (princ)
)
;;; =================================================================
;;; 获取包含指定线型的图层
(defun TT-01 (xianxing / layers)
  (setq layers '())
  (setq layers (get_layer_linetype xianxing)) ; 获取包含指定线型的图层
  layers
)
(defun get_layer (/ layer_info layers) ; 返回当前图纸中图层信息
  (setq layer_info (tblnext "layer" t))
  (while (/= layer_info nil)
    (setq layers (append
                   layers
                   (list layer_info)
                 )
    )
    (setq layer_info (tblnext "layer"))
  )
  layers
)
(defun get_layer_linetype (linetype / ly_info ly_infos tmplist) ; 提取包含指定线型的图层
  (setq ly_Infos (get_layer))
  (foreach ly_info ly_Infos
    (if (= linetype (substr (cdr (assoc 6 ly_info)) 1 (strlen linetype)))
      (setq tmplist (append
                      tmplist
                      (list (CDR (assoc 2 ly_info)))
                    )
      )
    )
  )
  tmplist
)
;;; =================================================================
;;; 获取特征点坐标
(defun TT-02 (SS / ent i lst_pt lstl n pt)
  (setq LST_PT '()
        I 0
  )
  (repeat (sslength SS)
    (setq ENT (entget (ssname SS I)))
    (foreach N ENT
      (if (<= 10 (car N) 19)
        (setq PT (cdr N)
              LST_PT (cons PT LST_PT)
        )
      )
    )
    (setq I (1+ I))
  )
  (setq i 0
        LSTL '()
  )
  (while (< i (length LST_PT))
    (setq LSTL (cons (list (car (nth i LST_PT)) (cadr (nth i LST_PT)) 0.0) LSTL))
    (setq i (+ 1 i))
  )
  (setq LST_PT LSTL)                   ; 返回
  (reverse LST_PT)
)
;;; =================================================================
;;; 提炼 X 坐标，并排序
(defun TT-03 (LST_PT / e1 e2 i lst_x lstl pt tmp x y)
  (setq LST_X '())
  (foreach PT LST_PT
    (setq X (car PT)
          Y (cadr PT)
    )
    (if (setq TMP (assoc X LST_X))
      (setq LST_X (subst
                    (append
                      (list X Y)
                      (cdr TMP)
                    )
                    TMP
                    LST_X
                  )
      )
      (setq LST_X (cons (list X Y) LST_X))
    )
  )                                    ; 排序
  (setq LST_X (mapcar
                '(lambda (E1)
                   (cons (car E1) (vl-sort (cdr E1) '<))
                 )
                LST_X
              )
  )
  (setq LST_X (vl-sort LST_X '(lambda (E1 E2)
                                (< (car E1) (car E2))
                              )
              )
  )
  (setq i 0
        LSTL '()
  )
  (while (< i (length LST_X))
    (setq LSTL (cons (list (car (nth i LST_X)) (cadr (nth i LST_X)) 0.0) LSTL))
    (setq i (+ 1 i))
  )
  (setq LST_X (reverse LSTL))          ; 返回
  LST_X
)
;;; =================================================================
;;; 提炼 Y 坐标，并排序
(defun TT-04 (LST_PT / e1 e2 i lst_y lstl pt tmp x y)
  (setq LST_Y '())
  (foreach PT LST_PT
    (setq X (car PT)
          Y (cadr PT)
    )
    (if (setq TMP (assoc Y LST_Y))
      (setq LST_Y (subst
                    (append
                      (list Y X)
                      (cdr TMP)
                    )
                    TMP
                    LST_Y
                  )
      )
      (setq LST_Y (cons (list Y X) LST_Y))
    )
  )                                    ; 排序
  (setq LST_Y (mapcar
                '(lambda (E1)
                   (cons (car E1) (vl-sort (cdr E1) '<))
                 )
                LST_Y
              )
  )
  (setq LST_Y (vl-sort LST_Y '(lambda (E1 E2)
                                (< (car E1) (car E2))
                              )
              )
  )
  (setq i 0
        LSTL '()
  )
  (while (< i (length LST_Y))
    (setq LSTL (cons (list (car (nth i LST_Y)) (cadr (nth i LST_Y)) 0.0) LSTL))
    (setq i (+ 1 i))
  )
  (setq LST_Y (reverse LSTL))          ; 返回
  LST_Y
)
;;; =================================================================
;;; 提炼 X 坐标，并排序  (由大到小)
(defun TT-05 (LST_PT / e1 e2 i lst_x lstl pt tmp x y)
  (setq LST_X '())
  (foreach PT LST_PT
    (setq X (car PT)
          Y (cadr PT)
    )
    (if (setq TMP (assoc X LST_X))
      (setq LST_X (subst
                    (append
                      (list X Y)
                      (cdr TMP)
                    )
                    TMP
                    LST_X
                  )
      )
      (setq LST_X (cons (list X Y) LST_X))
    )
  )                                    ; 排序
  (setq LST_X (mapcar
                '(lambda (E1)
                   (cons (car E1) (vl-sort (cdr E1) '<))
                 )
                LST_X
              )
  )
  (setq LST_X (vl-sort LST_X '(lambda (E1 E2)
                                (< (car E1) (car E2))
                              )
              )
  )
  (setq i 0
        LSTL '()
  )
  (while (< i (length LST_X))
    (setq LSTL (cons (list (car (nth i LST_X)) (nth (- (length (nth i LST_X)) 1) (nth i LST_X)) 0.0)
                     LSTL
               )
    )
    (setq i (+ 1 i))
  )
  (setq LST_X (reverse LSTL))          ; 返回
  LST_X
)
;;; =================================================================
;;; 提炼 Y 坐标，并排序    (由大到小)
(defun TT-06 (LST_PT / e1 e2 i lst_y lstl pt tmp x y)
  (setq LST_Y '())
  (foreach PT LST_PT
    (setq X (car PT)
          Y (cadr PT)
    )
    (if (setq TMP (assoc Y LST_Y))
      (setq LST_Y (subst
                    (append
                      (list Y X)
                      (cdr TMP)
                    )
                    TMP
                    LST_Y
                  )
      )
      (setq LST_Y (cons (list Y X) LST_Y))
    )
  )                                    ; 排序
  (setq LST_Y (mapcar
                '(lambda (E1)
                   (cons (car E1) (vl-sort (cdr E1) '<))
                 )
                LST_Y
              )
  )
  (setq LST_Y (vl-sort LST_Y '(lambda (E1 E2)
                                (< (car E1) (car E2))
                              )
              )
  )
  (setq i 0
        LSTL '()
  )
  (while (< i (length LST_Y))
    (setq LSTL (cons (list (car (nth i LST_Y)) (nth (- (length (nth i LST_Y)) 1) (nth i LST_Y)) 0.0)
                     LSTL
               )
    )
    (setq i (+ 1 i))
  )
  (setq LST_Y (reverse LSTL))          ; 返回
  LST_Y
)
;;; =================================================================
;;; 标注
(defun TT-07 (LST_X LST_Y PT0 SC ppp / ent pt pt1 str tmp x y) ; 标注 X
  (setq LSTLX '()
        LSTLY '()
  )
  (foreach TMP LST_X
    (setq X (car TMP)
          Y (cadr TMP)
          PT (list X Y 0.0)            ;       STR (rtos (* SC (- X (car
                                       ; PT0))));;标注的数据为实际数值
          STR (rtos (TT-09 (* SC (- X (car PT0))) 2)) ; 标注的数据保留小数点后2位

    )
    (if (and
          (/= (TT-09 X 4) (TT-09 (car Xlins) 4))
          (not (member (TT-09 X 4) Xlins))
        )
      (progn
        (setq X_LAST (max
                       X
                       X_LAST
                     )
              PT1 (list X_LAST (- (cadr PT0) (* 1.0 SC)) 0.0) ; _标注点
              X_LAST (+ X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))) ; 调整1.5调整标注间距?
                                       ; ?
                                       ; 小

        )
        (setq Xlins (cons (TT-09 X 4) Xlins))
        (setq Xzuih X_LAST)            ;    (vl-cmdf "_dimordinate" PT "x" "t"  STR PT1)
                                       ; ;;标注负号
        (vl-cmdf "_dimordinate" PT "x" "t" (rtos (abs (atof STR)) 2 2) PT1) ; 不标注负号
        (setq ent (entlast))
        (setq LSTLX (cons ent LSTLX))
        (TT-08 ent ppp PT0)            ; 对齐坐标
      )
    )
  )                                    ; 标注 Y
  (foreach TMP LST_Y
    (setq Y (car TMP)
          X (cadr TMP)
          PT (list X Y 0.0)            ;       STR (rtos (* SC (- Y (cadr PT0))))
                                       ; ;;标注的数据为实际数值
          STR (rtos (TT-09 (* SC (- Y (cadr PT0))) 2)) ; 标注的数据保留小数点后2位

    )
    (if (and
          (/= (TT-09 Y 4) (TT-09 (car Ylins) 4))
          (not (member (TT-09 Y 4) Ylins))
        )
      (progn
        (setq Y_LAST (max
                       Y
                       Y_LAST
                     )
              PT1 (list (- (car PT0) (* 1.0 SC)) Y_LAST 0.0) ; _标注点
              Y_LAST (+ Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))) ; 调整1.5调整标注间距?
                                       ; ?
                                       ; 小

        )
        (setq Ylins (cons (TT-09 Y 4) Ylins))
        (setq Yzuih Y_LAST)            ;    (vl-cmdf "_dimordinate" PT "Y" "t"  STR PT1)
                                       ; ;;标注负号
        (vl-cmdf "_dimordinate" PT "Y" "t" (rtos (abs (atof STR)) 2 2) PT1) ; 不标注负号
        (setq ent (entlast))
        (setq LSTLY (cons ent LSTLY))
        (TT-08 ent ppp PT0)            ; 对齐坐标
      )
    )
  )
)
;;; =================================================================
;;;     点坐标对齐
(defun TT-08 (ent p0 PT0 / np14 p0x p0y p14x p14y p70) ; 点坐标对齐
  (setq ent (entget ent))
  (setq p70 (cdr (assoc 70 ent))
        p14x (car (cdr (assoc 14 ent)))
        p14y (cadr (cdr (assoc 14 ent)))
  )
  (setq p0x (car p0)
        p0y (cadr p0)
  )
  (cond
    ((= p70 38.0)
      (setq np14 (list p0x p14y 0.0))
    )
    ((= p70 102.0)
      (setq np14 (list p14x p0y 0.0))
    )
    (t
      (exit)
    )
  )
  (setq ent (subst
              (cons 14 nP14)
              (assoc 14 ent)
              ent
            )
  )
  (setq ent (subst
              (cons 10 PT0)
              (assoc 10 ent)
              ent
            )
  )
  (entmod ent)
  (princ)
)
;;; =================================================================
;;; 四舍五入函数，ent:实数，n：小数点保留位数
(defun TT-09 (ent n / fh)
  (if (>= ent 0.0)
    (setq FH +)
    (setq FH -)
  )
  (setq ent (/ (atof (itoa (fix (fh (* ent (expt 10 n)) 0.5)))) (expt 10 n)))
  ent
)
;;; =================================================================
;;; 优化中心线点X坐标
(defun TT-10 (ss xxx / ent ent1 i ptzhongxinx ptzhongxiny ssguol2 x1 x2 y1 y2)
  (setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
         "CENTER" "CENTER2"
         "CENTERX2" "DASHDOT"
         "DASHDOT2" "DASHDOTX2"
        )
  )                                    ; 下面程序将中心线图层加入一个列表
  (setq ssguol2 (append
                  SSguol2
                  (TT-01 "ACAD_ISO04W100")
                  (TT-01 "ACAD_ISO08W100")
                  (TT-01 "CENTER")
                  (TT-01 "CENTER2")
                  (TT-01 "CENTERX2")
                  (TT-01 "DASHDOT")
                  (TT-01 "DASHDOT2")
                  (TT-01 "DASHDOTX2")
                )
  )                                    ; 下面程序将选择集中随层的中心线加入一个列表
  (SETQ i 0
        PTzhongxinX '()
        PTzhongxinY '()
  )
  (while (< i (sslength ss))
    (setq ent (ssname ss i))
    (setq ent1 (entget ent))
    (if (or
          (and
            (member (cdr (assoc 8 ent1)) ssguol2)
            (/= (cdr (assoc 0 ent1)) "INSERT")
            (= (assoc 6 ent1) nil)
          )
          (member (cdr (assoc 6 ent1)) ssguol2)
        )
      (progn
        (setq X1 (car (cdr (assoc 10 ent1)))
              Y1 (cadr (cdr (assoc 10 ent1)))
              X2 (car (cdr (assoc 11 ent1)))
              Y2 (cadr (cdr (assoc 11 ent1)))
        )
        (if (= Y1 Y2)
          (progn
            (setq PTzhongxinX (cons (list X1 Y1 0.0) PTzhongxinX))
            (setq PTzhongxinX (cons (list X2 Y2 0.0) PTzhongxinX))
          )
        )
        (if (= X1 X2)
          (progn
            (setq PTzhongxinY (cons (list X1 Y1 0.0) PTzhongxinY))
            (setq PTzhongxinY (cons (list X2 Y2 0.0) PTzhongxinY))
          )
        )
      )
    )
    (SETQ i (+ 1 i))
  )
  (SETQ i 0)
  (while (< i (length PTzhongxinX))
    (if (member (nth i PTzhongxinX) xxx)
      (SETQ xxx (vl-remove (nth i PTzhongxinX) xxx))
    )
    (SETQ i (+ 1 i))
  )
  xxx
)
;;; =================================================================
;;; 优化中心线点Y坐标
(defun TT-11 (ss yyy / ent ent1 i ptzhongxinx ptzhongxiny ssguol2 x1 x2 y1 y2)
  (setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
         "CENTER" "CENTER2"
         "CENTERX2" "DASHDOT"
         "DASHDOT2" "DASHDOTX2"
        )
  )                                    ; 下面程序将中心线图层加入一个列表
  (setq ssguol2 (append
                  SSguol2
                  (TT-01 "ACAD_ISO04W100")
                  (TT-01 "ACAD_ISO08W100")
                  (TT-01 "CENTER")
                  (TT-01 "CENTER2")
                  (TT-01 "CENTERX2")
                  (TT-01 "DASHDOT")
                  (TT-01 "DASHDOT2")
                  (TT-01 "DASHDOTX2")
                )
  )                                    ; 下面程序将选择集中随层的中心线加入一个列表
  (SETQ i 0
        PTzhongxinX '()
        PTzhongxinY '()
  )
  (while (< i (sslength ss))
    (setq ent (ssname ss i))
    (setq ent1 (entget ent))
    (if (or
          (and
            (member (cdr (assoc 8 ent1)) ssguol2)
            (/= (cdr (assoc 0 ent1)) "INSERT")
            (= (assoc 6 ent1) nil)
          )
          (member (cdr (assoc 6 ent1)) ssguol2)
        )
      (progn
        (setq X1 (car (cdr (assoc 10 ent1)))
              Y1 (cadr (cdr (assoc 10 ent1)))
              X2 (car (cdr (assoc 11 ent1)))
              Y2 (cadr (cdr (assoc 11 ent1)))
        )
        (if (= Y1 Y2)
          (progn
            (setq PTzhongxinX (cons (list X1 Y1 0.0) PTzhongxinX))
            (setq PTzhongxinX (cons (list X2 Y2 0.0) PTzhongxinX))
          )
        )
        (if (= X1 X2)
          (progn
            (setq PTzhongxinY (cons (list Y1 X1 0.0) PTzhongxinY))
            (setq PTzhongxinY (cons (list Y2 X2 0.0) PTzhongxinY))
          )
        )
      )
    )
    (SETQ i (+ 1 i))
  )
  (SETQ i 0)
  (while (< i (length PTzhongxinY))
    (if (member (nth i PTzhongxinY) yyy)
      (SETQ yyy (vl-remove (nth i PTzhongxinY) yyy))
    )
    (SETQ i (+ 1 i))
  )
  yyy
)
;;; =================================================================
;;; 优化X坐标偏移
(defun TT-12 (lsp pt / ent ent1 i il lstl lsty lstz np14 x x_last x0 y0)
  (setq X0 (car pt))
  (setq Y0 (cadr pt))
  (setq i 0
        il 0
        LSTZ '()
        LSTY '()
  )
  (while (< i (length lsp))
    (setq X (car (cdr (assoc 13 (entget (nth i lsp))))))
    (if (<= X X0)
      (setq LSTZ (cons (nth i lsp) LSTZ))
      (setq LSTY (cons (nth i lsp) LSTY))
    )
    (SETQ i (+ 1 i))
  )
  (setq LSTZ LSTZ)
  (setq LSTY (reverse LSTY))
  (if (/= LSTZ '())
    (progn
      (setq i 0)
      (setq X_LAST (car (cdr (assoc 13 (entget (nth 0 LSTZ))))))
      (while (< i (length LSTZ))
        (setq ent (nth i LSTZ))
        (setq ent1 (entget ent))
        (setq X (car (cdr (assoc 13 ent1))))
        (setq X_LAST (min
                       X
                       X_LAST
                     )
        )
        (setq nP14 (list X_LAST (cadr (cdr (assoc 14 ent1))) 0.0))
        (setq ent1 (subst
                     (cons 14 nP14)
                     (assoc 14 ent1)
                     ent1
                   )
        )
        (entmod ent1)
        (SETQ i (+ 1 i))
        (setq X_LAST (- X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
      )
    )
  )
  (if (/= LSTY '())
    (progn
      (setq i 0)
      (setq X_LAST (+ X0 (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
      (while (< i (length LSTY))
        (setq ent (nth i LSTY))
        (setq ent1 (entget ent))
        (setq X (car (cdr (assoc 13 ent1))))
        (setq X_LAST (max
                       X
                       X_LAST
                     )
        )
        (setq nP14 (list X_LAST (cadr (cdr (assoc 14 ent1))) 0.0))
        (setq ent1 (subst
                     (cons 14 nP14)
                     (assoc 14 ent1)
                     ent1
                   )
        )
        (entmod ent1)
        (SETQ i (+ 1 i))
        (setq X_LAST (+ X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
      )
    )
  )
)
;;; =================================================================
;;; 优化Y坐标偏移
(defun TT-13 (lsp pt / ent ent1 i il lstl lsty lstz np14 x x_last x0 y0)
  (setq X0 (car pt))
  (setq Y0 (cadr pt))
  (setq i 0
        il 0
        LSTX '()
        LSTS '()
  )
  (while (< i (length lsp))
    (setq Y (cadr (cdr (assoc 13 (entget (nth i lsp))))))
    (if (<= Y Y0)
      (setq LSTX (cons (nth i lsp) LSTX))
      (setq LSTS (cons (nth i lsp) LSTS))
    )
    (SETQ i (+ 1 i))
  )
  (setq LSTX LSTX)
  (setq LSTS (reverse LSTS))
  (if (/= LSTX '())
    (progn
      (setq i 0)
      (setq Y_LAST (cadr (cdr (assoc 13 (entget (nth 0 LSTX))))))
      (while (< i (length LSTX))
        (setq ent (nth i LSTX))
        (setq ent1 (entget ent))
        (setq Y (cadr (cdr (assoc 13 ent1))))
        (setq Y_LAST (min
                       Y
                       Y_LAST
                     )
        )
        (setq nP14 (list (car (cdr (assoc 14 ent1))) Y_LAST 0.0))
        (setq ent1 (subst
                     (cons 14 nP14)
                     (assoc 14 ent1)
                     ent1
                   )
        )
        (entmod ent1)
        (SETQ i (+ 1 i))
        (setq Y_LAST (- Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
      )
    )
  )
  (if (/= LSTS '())
    (progn
      (setq i 0)
      (setq Y_LAST (+ Y0 (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
      (while (< i (length LSTS))
        (setq ent (nth i LSTS))
        (setq ent1 (entget ent))
        (setq Y (cadr (cdr (assoc 13 ent1))))
        (setq Y_LAST (max
                       Y
                       Y_LAST
                     )
        )
        (setq nP14 (list (car (cdr (assoc 14 ent1))) Y_LAST 0.0))
        (setq ent1 (subst
                     (cons 14 nP14)
                     (assoc 14 ent1)
                     ent1
                   )
        )
        (entmod ent1)
        (SETQ i (+ 1 i))
        (setq Y_LAST (+ Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
      )
    )
  );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (command "undo" "be")
  (setq orig_cmd(getvar "cmdecho"))  
  (setq orig_osm(getvar "osmode"))
  (setq orig_orth(getvar "orthomode"))
  (setq orig_lay(getvar "clayer"))
  (setq diml_f(getvar "dimlfac"))
  (setvar "errno" 0)
  (setq olderr *error*)
  (defun *error* (msg)
    (setq en_er (getvar "errno"))
    (setq errmsg (strcat "ERRNO = " (itoa en_er) "\nError: " msg))
    (prompt errmsg)
    (setq *error* olderr)
    (command "undo" "e")
    (command "undo" "")
    (prompt "\n")
    (prin1)
    )  
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "orthomode" 0)
  (setq cla(strcase orig_lay))


  (prompt"\n :")
  (if (setq ss(ssget))
    (progn
      (setq ss_n(sslength ss)
            n 0
            ssa(ssadd)
            ssl(ssadd)
            ssp(ssadd))
      (repeat ss_n
        (setq en(ssname ss n)
              en_type(cdr(assoc 0 (entget en))))
        (cond ((= "ARC" en_type)  (ssadd en ssa))
              ((= "LINE" en_type) (ssadd en ssl))
              ((= "LWPOLYLINE" en_type) (ssadd en ssp))
              )
        (setq n(1+ n))
        )
      )
    )
  (if(> (setq ssp_n(sslength ssp)) 0)
    (ex_pl)
    )
  (setq ssa_n(sslength ssa)
        ssl_n(sslength ssl))
  (if (> ssa_n 0)
    (progn
      (setq list_r '()
            n 0)
      (repeat ssa_n
        (setq en(ssname ssa n)
              en_r(cdr(assoc 40 (entget en))))
        (if(= n 0)
          (setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
          (progn
            (if(null (setq chk_r(member (rtos (* diml_f en_r) 2 3) list_r)))
              (setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
              )
            )
          )
        (setq n(1+ n))
        )
      (setq list_r_n(length list_r)
            n 0)
      (repeat list_r_n
        (setq te_r(nth n list_r)
              r_n 0
              n1 0)
        (repeat ssa_n
          (setq en(ssname ssa n1)
                en_r(cdr(assoc 40 (entget en))))
          (if(= te_r (rtos (* diml_f en_r) 2 3))
            (setq r_n(1+ r_n)
                  r_pt(cdr(assoc 10 (entget en))))
            )
          (setq n1(1+ n1))
          )        
        (setq pt1(getpoint r_pt "\n:")
              pt0(polar r_pt (angle r_pt pt1) (/ (atof te_r) diml_f)))
        (if(= "." (substr te_r 1 1))
          (setq te1 "R0")
          (setq te1 "R")
          )
        (if(= r_n 1)
          (setq te(strcat te1 te_r))
          (setq te(strcat (rtos r_n 2 0) "-" te1 te_r))
          )
        (if(> (car pt1) (car pt0))
          (setq pt2(polar pt1 0 0.5))
          (setq pt2(polar pt1 pi 0.5))
          )               
        (command "leader" pt0 pt1 "" te "")
        (setq n(1+ n))
        )
      )
    )
  (if(> ssl_n 0)
    (progn
      (setq ssc(ssadd)
            list_c '()
            n 0)
      (repeat ssl_n
        (setq en(ssname ssl n)
              en_ps(cdr(assoc 10 (entget en)))
              en_pe(cdr(assoc 11 (entget en)))
              dx(abs(- (car en_ps) (car en_pe)))
              dy(abs(- (cadr en_ps) (cadr en_pe))))
        (if(equal dx dy 0.001)
          (progn
            (ssadd en ssc)
            (if(null (setq chk_c(member (rtos (* diml_f dx) 2 1) list_c)))
              (setq list_c(cons (rtos (* diml_f dx) 2 1) list_c))
              )
            )
          )
        (setq n(1+ n))
        )
      (if(> (setq list_c_n(length list_c)) 0)
        (progn
          (setq n 0)
          (repeat list_c_n
            (setq te_c(nth n list_c)
                  ssc_n(sslength ssc)
                  n1 0
                  c_n 0)
            (repeat ssc_n
              (setq en(ssname ssc n1)
                    en_ps(cdr(assoc 10 (entget en)))
                    en_pe(cdr(assoc 11 (entget en)))
                    dx(abs(- (car en_ps) (car en_pe)))
                    )
              (if(= te_c (rtos (* diml_f dx) 2 1))
                (setq c_n(1+ c_n)
                      c_pt(list (/ (+ (car en_ps) (car en_pe)) 2) (/ (+ (cadr en_ps) (cadr en_pe)) 2))
                      )
                )
              (setq n1(1+ n1))
              )
            (setq pt1(getpoint c_pt "\n:"))
            (if(= "." (substr te_c 1 1))
              (setq te1 "C0")
              (setq te1 "C")
              )
            (if(= c_n 1)
              (setq te(strcat te1 te_c))
              (setq te(strcat (rtos c_n 2 0) "-" te1 te_c))
              )
            (if(> (car pt1) (car c_pt))
              (setq pt2(polar pt1 0 0.5))
              (setq pt2(polar pt1 pi 0.5))
              )            
            (command "leader" c_pt pt1 "" te "")
            (setq n(1+ n))
            )
          )
        )
      )
    )
  (if sst
    (command "erase" sst "")
    )
  (setq *error* olderr)
  (command "undo" "e")
  (setvar "cmdecho" orig_cmd)  
  (setvar "osmode" orig_osm)
  (setvar "orthomode" orig_orth)
  (setvar "clayer" orig_lay)
  (prin1)
  )

;;;(ex_pl)
(defun ex_pl(/ sst_n en en_type n)
  (command "-layer" "m" "temp-user" "c" "47" "temp-user" "lt" "hidden" "temp-user" "")
  (command "copy" ssp "" (list 0 0) (list 0 0))
  (command "change" ssp "" "p" "la" "temp-user" "")
  (command "explode" ssp)
  (setq sst(ssget "x" '((8 . "TEMP-USER"))))
  (setq sst_n(sslength sst)
        n 0)
  (repeat sst_n
    (setq en(ssname sst n)
          en_type(cdr(assoc 0 (entget en))))
    (cond((= "ARC" en_type) (ssadd en ssa))
         ((= "LINE" en_type) (ssadd en ssl))
         )
    (setq n(1+ n))
    )
  (setvar "clayer" orig_lay)
  (prin1)
)
(princ "\n");(setq t tt))

fl202

在程序末端添加：
(setvar "osmode" snap)

tang87

fl202 发表于 2016-8-3 09:35
在程序末端添加：
(setvar "osmode" snap)

可以了，谢谢

tang87

谁有自动标注的LISP源码分享下