我有个零件坐标标注的源码,希望有高手出来帮我改善一下

yang198910204 · 发表于 2012-9-24 22:43

本帖最后由 yang198910204 于 2012-9-24 23:08 编辑

首先各位大师
一个币只是为了能请大家来赏脸看一眼
现在我这个源码有两点不好
第一要指定基准点有一点点麻烦,我希望能自动以图形最左下角点为基准点
第二源码他收集了所有端点,我希望源码能筛选出圆弧和倒角的端点不要标注
就最两点最重要

其它还能接受
;;; =================================================================
;;; 自动坐标标注
;;; 原作者：zml84  由langjs修改于2009-05-25  命令：tt
;;; =================================================================
(defun C:TT (/ 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匡璶夹猔Rà㎝Cà瓜じ :")
  (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*** 欢迎使用冲模设计软件,快捷功能已成功加载如有问题可联系本人QQ:381200902源码大部分来自网络 *** <><><><> ***");(setq t tt))

yang198910204 · 发表于 2012-9-25 13:11

不会就这样沉了吧

linheyuanpcb · 发表于 2012-9-25 16:16

(setq ss (ssget '((0 . "LINE,CIRCLE,PLINE,LWPOLYLINE,INSERT"))))

这里改就行了，要标注的保留下来，不要的删除
倒只要标注圆心 (setq ss (ssget '((0 . "CIRCLE"))))
默认是0,0为基准的，不用输入可直接回车

linheyuanpcb · 发表于 2012-9-25 16:29

零点也可以这样就不用回车了
(setq PT0 '(0 0))

账号		自动登录	找回密码
密码			注册

我有个零件坐标标注的源码,希望有高手出来帮我改善一下

本帖子中包含更多资源

本帖被以下淘专辑推荐:

相关帖子