设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 这样标注出来的数值为什么不能改精度
返回列表 发新帖
查看: 824|回复: 6

[提问] 这样标注出来的数值为什么不能改精度

[复制链接]
dhy
发表于 2015-12-25 21:52:23 | 显示全部楼层 |阅读模式
这是早几天在论坛发现的源码，标注出来的数值如果能改精度，对我还说还是比较实用的，可是我对这样不会改，望哪位好心人帮忙改一下，万分感谢
  2. ; =================================================================
  3. ;;; 自动坐标标注
  4. ;;; 原作者：zml84  由langjs修改于2009-05-25  命令：tt
  5. ;;; =================================================================
  6. (defun C:ZB (/ chanshu001 ent ent1 i lst_1 lst_2 lst_3 lst_4 lst_pt lst_x lst_y lstlx lstly lstx1
  7.                lstx2 lsty1 lsty2 p001 p002 p003 p004 pmax pmay pminx pminy pt0 pt0linshijidian pzhx
  8.                pzhxl pzhy pzhyl sc snap ss ssguol uuu x_last xlins xxxx xzuih xzuihbak xzuihbak2
  9.                y_last ylins yyyy yzuih yzuihbak2 yzuihbak3 xsw
  10.             )
  11.   (setvar "cmdecho" 0)                 ; 关闭命令响应
  12.   (setq ss (ssget '((0 . "LINE,CIRCLE,PLINE,LWPOLYLINE,INSERT"))))
  13.   (setq PT0linshijidian '(0.0 0.0 0.0))
  14.   (setq PT0 (getpoint "\n指定基点: "))
  15.   (cond
  16.     ((null PT0)
  17.       (setq PT0 PT0linshijidian)
  18.     )
  19.     ((= PT0 0.0)
  20.       (setq PT0 PT0linshijidian)
  21.     )
  22.   )
  23.   (setq SC 1)
  24.   (setq SC (getreal "\n输入比例 <1>: "))
  25.   (cond
  26.     ((null SC)
  27.       (setq SC 1)
  28.     )
  29.     ((= uuu 0.0)
  30.       (setq SC 1)
  31.     )
  32.   )
  33.   (setq chanshu001 (* 7 (getvar "dimtxt") (getvar "dimscale")))
  34.   (setq uuu (atof (getstring (strcat "\n标注拉伸 <" (rtos chanshu001) ">:"))))
  35.   (cond
  36.     ((null uuu)
  37.       (setq uuu chanshu001)
  38.     )
  39.     ((= uuu 0.0)
  40.       (setq uuu chanshu001)
  41.     )
  42.   )                                    ; 下面程序设置过滤虚线条件
  43.   (setq ssguol '("ACAD_ISO03W100" "ACAD_ISO02W100"
  44.          "DASHED" "DASHED2"
  45.          "DASHEDX2" "HIDDEN"
  46.          "HIDDEN2" "HIDDENX2"
  47.         )
  48.   )                                    ; 下面程序将虚线图层加入虚线过滤条件
  49.   (setq ssguol (append
  50.                  SSguol
  51.                  (TT-01 "ACAD_ISO03W100")
  52.                  (TT-01 "ACAD_ISO02W100")
  53.                  (TT-01 "DASHED")
  54.                  (TT-01 "DASHED2")
  55.                  (TT-01 "DASHEDX2")
  56.                  (TT-01 "HIDDEN")
  57.                  (TT-01 "HIDDEN2")
  58.                  (TT-01 "HIDDENX2")
  59.                )
  60.   )                                    ; 下面程序将选择集中随层的虚线图层中的线过滤掉
  61.   (SETQ i 0)
  62.   (while (< i (sslength ss))
  63.     (setq ent (ssname ss i))
  64.     (setq ent1 (entget ent))
  65.     (if (and
  66.           (member (cdr (assoc 8 ent1)) ssguol)
  67.           (/= (cdr (assoc 0 ent1)) "INSERT")
  68.           (= (assoc 6 ent1) nil)
  69.         )
  70.       (setq ss (ssdel ent ss))
  71.       (SETQ i (+ 1 i))
  72.     )
  73.   )                                    ; 下面程序将选择集中其他层的虚线图元过滤掉
  74.   (SETQ i 0)
  75.   (while (< i (sslength ss))
  76.     (setq ent (ssname ss i))
  77.     (setq ent1 (entget ent))
  78.     (if (member (cdr (assoc 6 ent1)) ssguol)
  79.       (setq ss (ssdel ent ss))
  80.       (SETQ i (+ 1 i))
  81.     )
  82.   )                                    ; 主要程序
  83.   (vl-cmdf ".UNDO" "BE")               ; 设置UNDO起点
  84.   (setq snap (getvar "osmode"))
  85.   (setvar "osmode" 0)                  ; 关闭捕捉
  86.   (setq xsw (getvar "DIMZIN"))
  87.   (setvar "DIMZIN" 0)                  ; 关闭小数点末尾数为0时候省略
  88.   (progn
  89.     (setq LST_PT (TT-02 ss))
  90.     (setq LST_PT (cons PT0 LST_PT))    ; 下面程序坐标分象限
  91.     (setq i 1
  92.           pminx (car (nth 0 LST_PT))
  93.           pmax pminx
  94.           pminy (cadr (nth 0 LST_PT))
  95.           pmay pminy
  96.     )
  97.     (while (<= i (length LST_PT))
  98.       (setq xxxx (car (nth (- i 1) LST_PT)))
  99.       (setq yyyy (cadr (nth (- i 1) LST_PT)))
  100.       (cond
  101.         ((< xxxx pminx)
  102.           (setq pminx xxxx)
  103.         )
  104.         ((> xxxx pmax)
  105.           (setq pmax xxxx)
  106.         )
  107.         ((< yyyy pminy)
  108.           (setq pminy yyyy)
  109.         )
  110.         ((> yyyy pmay)
  111.           (setq pmay yyyy)
  112.         )
  113.         (t
  114.           (princ)
  115.         )
  116.       )
  117.       (setq i (+ i 1))
  118.     )                                  ; 求坐标范围中间数值
  119.     (setq pzhx (/ (+ pminx pmax) 2))
  120.     (setq pzhy (/ (+ pminy pmay) 2))   ; 求4个象限的坐标对齐点
  121.     (setq p001 (list (- pminx uuu) (- pminy uuu) 0.0)
  122.           p002 (list (- pminx uuu) (+ pmay uuu) 0.0)
  123.           p003 (list (+ pmax uuu) (- pminy uuu) 0.0)
  124.           p004 (list (+ pmax uuu) (+ pmay uuu) 0.0)
  125.     )                                  ; 将坐标分类到四个象限
  126.     (setq i 0
  127.           LST_1 '()
  128.           LST_2 '()
  129.           LST_3 '()
  130.           LST_4 '()
  131.     )
  132.     (while (< i (length LST_PT))
  133.       (setq pzhxl (car (nth i LST_PT))
  134.             pzhyl (cadr (nth i LST_PT))
  135.       )
  136.       (if (and
  137.             (<= pzhxl pzhx)
  138.             (<= pzhyl pzhy)
  139.           )
  140.         (setq LST_1 (cons (nth i LST_PT) LST_1))
  141.       )
  142.       (if (and
  143.             (<= pzhxl pzhx)
  144.             (> pzhyl pzhy)
  145.           )
  146.         (setq LST_2 (cons (nth i LST_PT) LST_2))
  147.       )
  148.       (if (and
  149.             (> pzhxl pzhx)
  150.             (<= pzhyl pzhy)
  151.           )
  152.         (setq LST_3 (cons (nth i LST_PT) LST_3))
  153.       )
  154.       (if (and
  155.             (> pzhxl pzhx)
  156.             (> pzhyl pzhy)
  157.           )
  158.         (setq LST_4 (cons (nth i LST_PT) LST_4))
  159.       )
  160.       (setq i (+ i 1))
  161.     )                                  ; 坐标分象限结束
  162.     (setq Xlins '(0.0)
  163.           Ylins '(0.0)
  164.     )
  165.     (setq LSTX1 '()
  166.           LSTX2 '()
  167.           LSTY1 '()
  168.           LSTY2 '()
  169.     )
  170.     (setq LST_X (TT-03 LST_1)
  171.           LST_Y (TT-04 LST_1)
  172.     )
  173.     (setq LST_X (TT-10 SS LST_X)
  174.           LST_Y (TT-11 SS LST_Y)
  175.     )
  176.     (setq X_LAST (caar LST_X))
  177.     (setq Y_LAST (caar LST_Y))
  178.     (TT-07 LST_X LST_Y PT0 SC p001)
  179.     (setq LSTX1 (append
  180.                   LSTX1
  181.                   (reverse LSTLX)
  182.                 )
  183.     )
  184.     (setq LSTY1 (append
  185.                   LSTY1
  186.                   (reverse LSTLY)
  187.                 )
  188.     )
  189.     (setq Xzuihbak Xzuih)
  190.     (setq LST_X (TT-05 LST_2)
  191.           LST_Y (TT-04 LST_2)
  192.     )
  193.     (setq LST_X (TT-10 SS LST_X)
  194.           LST_Y (TT-11 SS LST_Y)
  195.     )
  196.     (setq X_LAST (caar LST_X))
  197.     (TT-07 LST_X LST_Y PT0 SC p002)
  198.     (setq LSTX2 (append
  199.                   LSTX2
  200.                   (reverse LSTLX)
  201.                 )
  202.     )
  203.     (setq LSTY1 (append
  204.                   LSTY1
  205.                   (reverse LSTLY)
  206.                 )
  207.     )
  208.     (setq Xzuihbak2 Xzuih)
  209.     (setq Yzuihbak2 Yzuih)
  210.     (setq LST_X (TT-03 LST_3)
  211.           LST_Y (TT-06 LST_3)
  212.     )
  213.     (setq LST_X (TT-10 SS LST_X)
  214.           LST_Y (TT-11 SS LST_Y)
  215.     )
  216.     (setq X_LAST Xzuihbak)
  217.     (setq Y_LAST (caar LST_Y))
  218.     (TT-07 LST_X LST_Y PT0 SC p003)
  219.     (setq LSTX1 (append
  220.                   LSTX1
  221.                   (reverse LSTLX)
  222.                 )
  223.     )
  224.     (setq LSTY2 (append
  225.                   LSTY2
  226.                   (reverse LSTLY)
  227.                 )
  228.     )
  229.     (setq Yzuihbak3 Yzuih)
  230.     (setq X_LAST Xzuihbak2)
  231.     (setq LST_X (TT-05 LST_4)
  232.           LST_Y (TT-06 LST_4)
  233.     )
  234.     (if (= Yzuihbak2 Yzuihbak3)
  235.       (setq Y_LAST (caar LST_Y))
  236.       (setq Y_LAST Yzuihbak3)
  237.     )
  238.     (setq LST_X (TT-10 SS LST_X)
  239.           LST_Y (TT-11 SS LST_Y)
  240.     )
  241.     (TT-07 LST_X LST_Y PT0 SC p004)
  242.     (setq LSTX2 (append
  243.                   LSTX2
  244.                   (reverse LSTLX)
  245.                 )
  246.     )
  247.     (setq LSTY2 (append
  248.                   LSTY2
  249.                   (reverse LSTLY)
  250.                 )
  251.     )
  252.   )
  253.   (TT-12 LSTX1 PT0)
  254.   (TT-13 LSTY1 PT0)
  255.   (TT-12 LSTX2 PT0)
  256.   (TT-13 LSTY2 PT0)
  257.   (vl-cmdf ".UNDO" "E")                ; 设置UNDO终点
  258.   (setvar "osmode" snap)
  259.   (setvar "DIMZIN" xsw)
  260.   (princ)
  261. )
  262. ;;; =================================================================
  263. ;;; 获取包含指定线型的图层
  264. (defun TT-01 (xianxing / layers)
  265.   (setq layers '())
  266.   (setq layers (get_layer_linetype xianxing)) ; 获取包含指定线型的图层
  267.   layers
  268. )
  269. (defun get_layer (/ layer_info layers) ; 返回当前图纸中图层信息
  270.   (setq layer_info (tblnext "layer" t))
  271.   (while (/= layer_info nil)
  272.     (setq layers (append
  273.                    layers
  274.                    (list layer_info)
  275.                  )
  276.     )
  277.     (setq layer_info (tblnext "layer"))
  278.   )
  279.   layers
  280. )
  281. (defun get_layer_linetype (linetype / ly_info ly_infos tmplist) ; 提取包含指定线型的图层
  282.   (setq ly_Infos (get_layer))
  283.   (foreach ly_info ly_Infos
  284.     (if (= linetype (substr (cdr (assoc 6 ly_info)) 1 (strlen linetype)))
  285.       (setq tmplist (append
  286.                       tmplist
  287.                       (list (CDR (assoc 2 ly_info)))
  288.                     )
  289.       )
  290.     )
  291.   )
  292.   tmplist
  293. )
  294. ;;; =================================================================
  295. ;;; 获取特征点坐标
  296. (defun TT-02 (SS / ent i lst_pt lstl n pt)
  297.   (setq LST_PT '()
  298.         I 0
  299.   )
  300.   (repeat (sslength SS)
  301.     (setq ENT (entget (ssname SS I)))
  302.     (foreach N ENT
  303.       (if (<= 10 (car N) 19)
  304.         (setq PT (cdr N)
  305.               LST_PT (cons PT LST_PT)
  306.         )
  307.       )
  308.     )
  309.     (setq I (1+ I))
  310.   )
  311.   (setq i 0
  312.         LSTL '()
  313.   )
  314.   (while (< i (length LST_PT))
  315.     (setq LSTL (cons (list (car (nth i LST_PT)) (cadr (nth i LST_PT)) 0.0) LSTL))
  316.     (setq i (+ 1 i))
  317.   )
  318.   (setq LST_PT LSTL)                   ; 返回
  319.   (reverse LST_PT)
  320. )
  321. ;;; =================================================================
  322. ;;; 提炼 X 坐标，并排序
  323. (defun TT-03 (LST_PT / e1 e2 i lst_x lstl pt tmp x y)
  324.   (setq LST_X '())
  325.   (foreach PT LST_PT
  326.     (setq X (car PT)
  327.           Y (cadr PT)
  328.     )
  329.     (if (setq TMP (assoc X LST_X))
  330.       (setq LST_X (subst
  331.                     (append
  332.                       (list X Y)
  333.                       (cdr TMP)
  334.                     )
  335.                     TMP
  336.                     LST_X
  337.                   )
  338.       )
  339.       (setq LST_X (cons (list X Y) LST_X))
  340.     )
  341.   )                                    ; 排序
  342.   (setq LST_X (mapcar
  343.                 '(lambda (E1)
  344.                    (cons (car E1) (vl-sort (cdr E1) '<))
  345.                  )
  346.                 LST_X
  347.               )
  348.   )
  349.   (setq LST_X (vl-sort LST_X '(lambda (E1 E2)
  350.                                 (< (car E1) (car E2))
  351.                               )
  352.               )
  353.   )
  354.   (setq i 0
  355.         LSTL '()
  356.   )
  357.   (while (< i (length LST_X))
  358.     (setq LSTL (cons (list (car (nth i LST_X)) (cadr (nth i LST_X)) 0.0) LSTL))
  359.     (setq i (+ 1 i))
  360.   )
  361.   (setq LST_X (reverse LSTL))          ; 返回
  362.   LST_X
  363. )
  364. ;;; =================================================================
  365. ;;; 提炼 Y 坐标，并排序
  366. (defun TT-04 (LST_PT / e1 e2 i lst_y lstl pt tmp x y)
  367.   (setq LST_Y '())
  368.   (foreach PT LST_PT
  369.     (setq X (car PT)
  370.           Y (cadr PT)
  371.     )
  372.     (if (setq TMP (assoc Y LST_Y))
  373.       (setq LST_Y (subst
  374.                     (append
  375.                       (list Y X)
  376.                       (cdr TMP)
  377.                     )
  378.                     TMP
  379.                     LST_Y
  380.                   )
  381.       )
  382.       (setq LST_Y (cons (list Y X) LST_Y))
  383.     )
  384.   )                                    ; 排序
  385.   (setq LST_Y (mapcar
  386.                 '(lambda (E1)
  387.                    (cons (car E1) (vl-sort (cdr E1) '<))
  388.                  )
  389.                 LST_Y
  390.               )
  391.   )
  392.   (setq LST_Y (vl-sort LST_Y '(lambda (E1 E2)
  393.                                 (< (car E1) (car E2))
  394.                               )
  395.               )
  396.   )
  397.   (setq i 0
  398.         LSTL '()
  399.   )
  400.   (while (< i (length LST_Y))
  401.     (setq LSTL (cons (list (car (nth i LST_Y)) (cadr (nth i LST_Y)) 0.0) LSTL))
  402.     (setq i (+ 1 i))
  403.   )
  404.   (setq LST_Y (reverse LSTL))          ; 返回
  405.   LST_Y
  406. )
  407. ;;; =================================================================
  408. ;;; 提炼 X 坐标，并排序  (由大到小)
  409. (defun TT-05 (LST_PT / e1 e2 i lst_x lstl pt tmp x y)
  410.   (setq LST_X '())
  411.   (foreach PT LST_PT
  412.     (setq X (car PT)
  413.           Y (cadr PT)
  414.     )
  415.     (if (setq TMP (assoc X LST_X))
  416.       (setq LST_X (subst
  417.                     (append
  418.                       (list X Y)
  419.                       (cdr TMP)
  420.                     )
  421.                     TMP
  422.                     LST_X
  423.                   )
  424.       )
  425.       (setq LST_X (cons (list X Y) LST_X))
  426.     )
  427.   )                                    ; 排序
  428.   (setq LST_X (mapcar
  429.                 '(lambda (E1)
  430.                    (cons (car E1) (vl-sort (cdr E1) '<))
  431.                  )
  432.                 LST_X
  433.               )
  434.   )
  435.   (setq LST_X (vl-sort LST_X '(lambda (E1 E2)
  436.                                 (< (car E1) (car E2))
  437.                               )
  438.               )
  439.   )
  440.   (setq i 0
  441.         LSTL '()
  442.   )
  443.   (while (< i (length LST_X))
  444.     (setq LSTL (cons (list (car (nth i LST_X)) (nth (- (length (nth i LST_X)) 1) (nth i LST_X)) 0.0)
  445.                      LSTL
  446.                )
  447.     )
  448.     (setq i (+ 1 i))
  449.   )
  450.   (setq LST_X (reverse LSTL))          ; 返回
  451.   LST_X
  452. )
  453. ;;; =================================================================
  454. ;;; 提炼 Y 坐标，并排序    (由大到小)
  455. (defun TT-06 (LST_PT / e1 e2 i lst_y lstl pt tmp x y)
  456.   (setq LST_Y '())
  457.   (foreach PT LST_PT
  458.     (setq X (car PT)
  459.           Y (cadr PT)
  460.     )
  461.     (if (setq TMP (assoc Y LST_Y))
  462.       (setq LST_Y (subst
  463.                     (append
  464.                       (list Y X)
  465.                       (cdr TMP)
  466.                     )
  467.                     TMP
  468.                     LST_Y
  469.                   )
  470.       )
  471.       (setq LST_Y (cons (list Y X) LST_Y))
  472.     )
  473.   )                                    ; 排序
  474.   (setq LST_Y (mapcar
  475.                 '(lambda (E1)
  476.                    (cons (car E1) (vl-sort (cdr E1) '<))
  477.                  )
  478.                 LST_Y
  479.               )
  480.   )
  481.   (setq LST_Y (vl-sort LST_Y '(lambda (E1 E2)
  482.                                 (< (car E1) (car E2))
  483.                               )
  484.               )
  485.   )
  486.   (setq i 0
  487.         LSTL '()
  488.   )
  489.   (while (< i (length LST_Y))
  490.     (setq LSTL (cons (list (car (nth i LST_Y)) (nth (- (length (nth i LST_Y)) 1) (nth i LST_Y)) 0.0)
  491.                      LSTL
  492.                )
  493.     )
  494.     (setq i (+ 1 i))
  495.   )
  496.   (setq LST_Y (reverse LSTL))          ; 返回
  497.   LST_Y
  498. )
  499. ;;; =================================================================
  500. ;;; 标注
  501. (defun TT-07 (LST_X LST_Y PT0 SC ppp / ent pt pt1 str tmp x y) ; 标注 X
  502.   (setq LSTLX '()
  503.         LSTLY '()
  504.   )
  505.   (foreach TMP LST_X
  506.     (setq X (car TMP)
  507.           Y (cadr TMP)
  508.           PT (list X Y 0.0)            ;       STR (rtos (* SC (- X (car
  509.                                        ; PT0))));;标注的数据为实际数值
  510.           STR (rtos (TT-09 (* SC (- X (car PT0))) 2)) ; 标注的数据保留小数点后2位
  511.     )
  512.     (if (and
  513.           (/= (TT-09 X 4) (TT-09 (car Xlins) 4))
  514.           (not (member (TT-09 X 4) Xlins))
  515.         )
  516.       (progn
  517.         (setq X_LAST (max
  518.                        X
  519.                        X_LAST
  520.                      )
  521.               PT1 (list X_LAST (- (cadr PT0) (* 1.0 SC)) 0.0) ; _标注点
  522.               X_LAST (+ X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))) ; 调整1.5调整标注间距?
  523.                                        ; ?
  524.                                        ; 小
  525.         )
  526.         (setq Xlins (cons (TT-09 X 4) Xlins))
  527.         (setq Xzuih X_LAST)            ;    (vl-cmdf "_dimordinate" PT "x" "t"  STR PT1)
  528.                                        ; ;;标注负号
  529.         (vl-cmdf "_dimordinate" PT "x" "t" (rtos (abs (atof STR)) 2 2) PT1) ; 不标注负号
  530.         (setq ent (entlast))
  531.         (setq LSTLX (cons ent LSTLX))
  532.         (TT-08 ent ppp PT0)            ; 对齐坐标
  533.       )
  534.     )
  535.   )                                    ; 标注 Y
  536.   (foreach TMP LST_Y
  537.     (setq Y (car TMP)
  538.           X (cadr TMP)
  539.           PT (list X Y 0.0)            ;       STR (rtos (* SC (- Y (cadr PT0))))
  540.                                        ; ;;标注的数据为实际数值
  541.           STR (rtos (TT-09 (* SC (- Y (cadr PT0))) 2)) ; 标注的数据保留小数点后2位
  542.     )
  543.     (if (and
  544.           (/= (TT-09 Y 4) (TT-09 (car Ylins) 4))
  545.           (not (member (TT-09 Y 4) Ylins))
  546.         )
  547.       (progn
  548.         (setq Y_LAST (max
  549.                        Y
  550.                        Y_LAST
  551.                      )
  552.               PT1 (list (- (car PT0) (* 1.0 SC)) Y_LAST 0.0) ; _标注点
  553.               Y_LAST (+ Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))) ; 调整1.5调整标注间距?
  554.                                        ; ?
  555.                                        ; 小
  556.         )
  557.         (setq Ylins (cons (TT-09 Y 4) Ylins))
  558.         (setq Yzuih Y_LAST)            ;    (vl-cmdf "_dimordinate" PT "Y" "t"  STR PT1)
  559.                                        ; ;;标注负号
  560.         (vl-cmdf "_dimordinate" PT "Y" "t" (rtos (abs (atof STR)) 2 2) PT1) ; 不标注负号
  561.         (setq ent (entlast))
  562.         (setq LSTLY (cons ent LSTLY))
  563.         (TT-08 ent ppp PT0)            ; 对齐坐标
  564.       )
  565.     )
  566.   )
  567. )
  568. ;;; =================================================================
  569. ;;;     点坐标对齐
  570. (defun TT-08 (ent p0 PT0 / np14 p0x p0y p14x p14y p70) ; 点坐标对齐
  571.   (setq ent (entget ent))
  572.   (setq p70 (cdr (assoc 70 ent))
  573.         p14x (car (cdr (assoc 14 ent)))
  574.         p14y (cadr (cdr (assoc 14 ent)))
  575.   )
  576.   (setq p0x (car p0)
  577.         p0y (cadr p0)
  578.   )
  579.   (cond
  580.     ((= p70 38.0)
  581.       (setq np14 (list p0x p14y 0.0))
  582.     )
  583.     ((= p70 102.0)
  584.       (setq np14 (list p14x p0y 0.0))
  585.     )
  586.     (t
  587.       (exit)
  588.     )
  589.   )
  590.   (setq ent (subst
  591.               (cons 14 nP14)
  592.               (assoc 14 ent)
  593.               ent
  594.             )
  595.   )
  596.   (setq ent (subst
  597.               (cons 10 PT0)
  598.               (assoc 10 ent)
  599.               ent
  600.             )
  601.   )
  602.   (entmod ent)
  603.   (princ)
  604. )
  605. ;;; =================================================================
  606. ;;; 四舍五入函数，ent:实数，n：小数点保留位数
  607. (defun TT-09 (ent n / fh)
  608.   (if (>= ent 0.0)
  609.     (setq FH +)
  610.     (setq FH -)
  611.   )
  612.   (setq ent (/ (atof (itoa (fix (fh (* ent (expt 10 n)) 0.5)))) (expt 10 n)))
  613.   ent
  614. )
  615. ;;; =================================================================
  616. ;;; 优化中心线点X坐标
  617. (defun TT-10 (ss xxx / ent ent1 i ptzhongxinx ptzhongxiny ssguol2 x1 x2 y1 y2)
  618.   (setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
  619.          "CENTER" "CENTER2"
  620.          "CENTERX2" "DASHDOT"
  621.          "DASHDOT2" "DASHDOTX2"
  622.         )
  623.   )                                    ; 下面程序将中心线图层加入一个列表
  624.   (setq ssguol2 (append
  625.                   SSguol2
  626.                   (TT-01 "ACAD_ISO04W100")
  627.                   (TT-01 "ACAD_ISO08W100")
  628.                   (TT-01 "CENTER")
  629.                   (TT-01 "CENTER2")
  630.                   (TT-01 "CENTERX2")
  631.                   (TT-01 "DASHDOT")
  632.                   (TT-01 "DASHDOT2")
  633.                   (TT-01 "DASHDOTX2")
  634.                 )
  635.   )                                    ; 下面程序将选择集中随层的中心线加入一个列表
  636.   (SETQ i 0
  637.         PTzhongxinX '()
  638.         PTzhongxinY '()
  639.   )
  640.   (while (< i (sslength ss))
  641.     (setq ent (ssname ss i))
  642.     (setq ent1 (entget ent))
  643.     (if (or
  644.           (and
  645.             (member (cdr (assoc 8 ent1)) ssguol2)
  646.             (/= (cdr (assoc 0 ent1)) "INSERT")
  647.             (= (assoc 6 ent1) nil)
  648.           )
  649.           (member (cdr (assoc 6 ent1)) ssguol2)
  650.         )
  651.       (progn
  652.         (setq X1 (car (cdr (assoc 10 ent1)))
  653.               Y1 (cadr (cdr (assoc 10 ent1)))
  654.               X2 (car (cdr (assoc 11 ent1)))
  655.               Y2 (cadr (cdr (assoc 11 ent1)))
  656.         )
  657.         (if (= Y1 Y2)
  658.           (progn
  659.             (setq PTzhongxinX (cons (list X1 Y1 0.0) PTzhongxinX))
  660.             (setq PTzhongxinX (cons (list X2 Y2 0.0) PTzhongxinX))
  661.           )
  662.         )
  663.         (if (= X1 X2)
  664.           (progn
  665.             (setq PTzhongxinY (cons (list X1 Y1 0.0) PTzhongxinY))
  666.             (setq PTzhongxinY (cons (list X2 Y2 0.0) PTzhongxinY))
  667.           )
  668.         )
  669.       )
  670.     )
  671.     (SETQ i (+ 1 i))
  672.   )
  673.   (SETQ i 0)
  674.   (while (< i (length PTzhongxinX))
  675.     (if (member (nth i PTzhongxinX) xxx)
  676.       (SETQ xxx (vl-remove (nth i PTzhongxinX) xxx))
  677.     )
  678.     (SETQ i (+ 1 i))
  679.   )
  680.   xxx
  681. )
  682. ;;; =================================================================
  683. ;;; 优化中心线点Y坐标
  684. (defun TT-11 (ss yyy / ent ent1 i ptzhongxinx ptzhongxiny ssguol2 x1 x2 y1 y2)
  685.   (setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
  686.          "CENTER" "CENTER2"
  687.          "CENTERX2" "DASHDOT"
  688.          "DASHDOT2" "DASHDOTX2"
  689.         )
  690.   )                                    ; 下面程序将中心线图层加入一个列表
  691.   (setq ssguol2 (append
  692.                   SSguol2
  693.                   (TT-01 "ACAD_ISO04W100")
  694.                   (TT-01 "ACAD_ISO08W100")
  695.                   (TT-01 "CENTER")
  696.                   (TT-01 "CENTER2")
  697.                   (TT-01 "CENTERX2")
  698.                   (TT-01 "DASHDOT")
  699.                   (TT-01 "DASHDOT2")
  700.                   (TT-01 "DASHDOTX2")
  701.                 )
  702.   )                                    ; 下面程序将选择集中随层的中心线加入一个列表
  703.   (SETQ i 0
  704.         PTzhongxinX '()
  705.         PTzhongxinY '()
  706.   )
  707.   (while (< i (sslength ss))
  708.     (setq ent (ssname ss i))
  709.     (setq ent1 (entget ent))
  710.     (if (or
  711.           (and
  712.             (member (cdr (assoc 8 ent1)) ssguol2)
  713.             (/= (cdr (assoc 0 ent1)) "INSERT")
  714.             (= (assoc 6 ent1) nil)
  715.           )
  716.           (member (cdr (assoc 6 ent1)) ssguol2)
  717.         )
  718.       (progn
  719.         (setq X1 (car (cdr (assoc 10 ent1)))
  720.               Y1 (cadr (cdr (assoc 10 ent1)))
  721.               X2 (car (cdr (assoc 11 ent1)))
  722.               Y2 (cadr (cdr (assoc 11 ent1)))
  723.         )
  724.         (if (= Y1 Y2)
  725.           (progn
  726.             (setq PTzhongxinX (cons (list X1 Y1 0.0) PTzhongxinX))
  727.             (setq PTzhongxinX (cons (list X2 Y2 0.0) PTzhongxinX))
  728.           )
  729.         )
  730.         (if (= X1 X2)
  731.           (progn
  732.             (setq PTzhongxinY (cons (list Y1 X1 0.0) PTzhongxinY))
  733.             (setq PTzhongxinY (cons (list Y2 X2 0.0) PTzhongxinY))
  734.           )
  735.         )
  736.       )
  737.     )
  738.     (SETQ i (+ 1 i))
  739.   )
  740.   (SETQ i 0)
  741.   (while (< i (length PTzhongxinY))
  742.     (if (member (nth i PTzhongxinY) yyy)
  743.       (SETQ yyy (vl-remove (nth i PTzhongxinY) yyy))
  744.     )
  745.     (SETQ i (+ 1 i))
  746.   )
  747.   yyy
  748. )
  749. ;;; =================================================================
  750. ;;; 优化X坐标偏移
  751. (defun TT-12 (lsp pt / ent ent1 i il lstl lsty lstz np14 x x_last x0 y0)
  752.   (setq X0 (car pt))
  753.   (setq Y0 (cadr pt))
  754.   (setq i 0
  755.         il 0
  756.         LSTZ '()
  757.         LSTY '()
  758.   )
  759.   (while (< i (length lsp))
  760.     (setq X (car (cdr (assoc 13 (entget (nth i lsp))))))
  761.     (if (<= X X0)
  762.       (setq LSTZ (cons (nth i lsp) LSTZ))
  763.       (setq LSTY (cons (nth i lsp) LSTY))
  764.     )
  765.     (SETQ i (+ 1 i))
  766.   )
  767.   (setq LSTZ LSTZ)
  768.   (setq LSTY (reverse LSTY))
  769.   (if (/= LSTZ '())
  770.     (progn
  771.       (setq i 0)
  772.       (setq X_LAST (car (cdr (assoc 13 (entget (nth 0 LSTZ))))))
  773.       (while (< i (length LSTZ))
  774.         (setq ent (nth i LSTZ))
  775.         (setq ent1 (entget ent))
  776.         (setq X (car (cdr (assoc 13 ent1))))
  777.         (setq X_LAST (min
  778.                        X
  779.                        X_LAST
  780.                      )
  781.         )
  782.         (setq nP14 (list X_LAST (cadr (cdr (assoc 14 ent1))) 0.0))
  783.         (setq ent1 (subst
  784.                      (cons 14 nP14)
  785.                      (assoc 14 ent1)
  786.                      ent1
  787.                    )
  788.         )
  789.         (entmod ent1)
  790.         (SETQ i (+ 1 i))
  791.         (setq X_LAST (- X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
  792.       )
  793.     )
  794.   )
  795.   (if (/= LSTY '())
  796.     (progn
  797.       (setq i 0)
  798.       (setq X_LAST (+ X0 (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
  799.       (while (< i (length LSTY))
  800.         (setq ent (nth i LSTY))
  801.         (setq ent1 (entget ent))
  802.         (setq X (car (cdr (assoc 13 ent1))))
  803.         (setq X_LAST (max
  804.                        X
  805.                        X_LAST
  806.                      )
  807.         )
  808.         (setq nP14 (list X_LAST (cadr (cdr (assoc 14 ent1))) 0.0))
  809.         (setq ent1 (subst
  810.                      (cons 14 nP14)
  811.                      (assoc 14 ent1)
  812.                      ent1
  813.                    )
  814.         )
  815.         (entmod ent1)
  816.         (SETQ i (+ 1 i))
  817.         (setq X_LAST (+ X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
  818.       )
  819.     )
  820.   )
  821. )
  822. ;;; =================================================================
  823. ;;; 优化Y坐标偏移
  824. (defun TT-13 (lsp pt / ent ent1 i il lstl lsty lstz np14 x x_last x0 y0)
  825.   (setq X0 (car pt))
  826.   (setq Y0 (cadr pt))
  827.   (setq i 0
  828.         il 0
  829.         LSTX '()
  830.         LSTS '()
  831.   )
  832.   (while (< i (length lsp))
  833.     (setq Y (cadr (cdr (assoc 13 (entget (nth i lsp))))))
  834.     (if (<= Y Y0)
  835.       (setq LSTX (cons (nth i lsp) LSTX))
  836.       (setq LSTS (cons (nth i lsp) LSTS))
  837.     )
  838.     (SETQ i (+ 1 i))
  839.   )
  840.   (setq LSTX LSTX)
  841.   (setq LSTS (reverse LSTS))
  842.   (if (/= LSTX '())
  843.     (progn
  844.       (setq i 0)
  845.       (setq Y_LAST (cadr (cdr (assoc 13 (entget (nth 0 LSTX))))))
  846.       (while (< i (length LSTX))
  847.         (setq ent (nth i LSTX))
  848.         (setq ent1 (entget ent))
  849.         (setq Y (cadr (cdr (assoc 13 ent1))))
  850.         (setq Y_LAST (min
  851.                        Y
  852.                        Y_LAST
  853.                      )
  854.         )
  855.         (setq nP14 (list (car (cdr (assoc 14 ent1))) Y_LAST 0.0))
  856.         (setq ent1 (subst
  857.                      (cons 14 nP14)
  858.                      (assoc 14 ent1)
  859.                      ent1
  860.                    )
  861.         )
  862.         (entmod ent1)
  863.         (SETQ i (+ 1 i))
  864.         (setq Y_LAST (- Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
  865.       )
  866.     )
  867.   )
  868.   (if (/= LSTS '())
  869.     (progn
  870.       (setq i 0)
  871.       (setq Y_LAST (+ Y0 (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
  872.       (while (< i (length LSTS))
  873.         (setq ent (nth i LSTS))
  874.         (setq ent1 (entget ent))
  875.         (setq Y (cadr (cdr (assoc 13 ent1))))
  876.         (setq Y_LAST (max
  877.                        Y
  878.                        Y_LAST
  879.                      )
  880.         )
  881.         (setq nP14 (list (car (cdr (assoc 14 ent1))) Y_LAST 0.0))
  882.         (setq ent1 (subst
  883.                      (cons 14 nP14)
  884.                      (assoc 14 ent1)
  885.                      ent1
  886.                    )
  887.         )
  888.         (entmod ent1)
  889.         (SETQ i (+ 1 i))
  890.         (setq Y_LAST (+ Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
  891.       )
  892.     )
  893.   );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  894.   (command "undo" "be")
  895.   (setq orig_cmd(getvar "cmdecho"))  
  896.   (setq orig_osm(getvar "osmode"))
  897.   (setq orig_orth(getvar "orthomode"))
  898.   (setq orig_lay(getvar "clayer"))
  899.   (setq diml_f(getvar "dimlfac"))
  900.   (setvar "errno" 0)
  901.   (setq olderr *error*)
  902.   (defun *error* (msg)
  903.     (setq en_er (getvar "errno"))
  904.     (setq errmsg (strcat "ERRNO = " (itoa en_er) "\nError: " msg))
  905.     (prompt errmsg)
  906.     (setq *error* olderr)
  907.     (command "undo" "e")
  908.     (command "undo" "")
  909.     (prompt "\n**")
  910.     (prin1)
  911.     )  
  912.   (setvar "cmdecho" 0)
  913.   (setvar "osmode" 0)
  914.   (setvar "orthomode" 0)
  915.   (setq cla(strcase orig_lay))

  917.   (prompt"\n匡璶夹猔Rà㎝Cà瓜じ :")
  918.   (if (setq ss(ssget))
  919.     (progn
  920.       (setq ss_n(sslength ss)
  921.      n 0
  922.      ssa(ssadd)
  923.      ssl(ssadd)
  924.      ssp(ssadd))
  925.       (repeat ss_n
  926. (setq en(ssname ss n)
  927.        en_type(cdr(assoc 0 (entget en))))
  928. (cond ((= "ARC" en_type)  (ssadd en ssa))
  929.        ((= "LINE" en_type) (ssadd en ssl))
  930.        ((= "LWPOLYLINE" en_type) (ssadd en ssp))
  931.        )
  932. (setq n(1+ n))
  933. )
  934.       )
  935.     )
  936.   (if(> (setq ssp_n(sslength ssp)) 0)
  937.     (ex_pl)
  938.     )
  939.   (setq ssa_n(sslength ssa)
  940. ssl_n(sslength ssl))
  941.   (if (> ssa_n 0)
  942.     (progn
  943.       (setq list_r '()
  944.      n 0)
  945.       (repeat ssa_n
  946. (setq en(ssname ssa n)
  947.        en_r(cdr(assoc 40 (entget en))))
  948. (if(= n 0)
  949.    (setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
  950.    (progn
  951.      (if(null (setq chk_r(member (rtos (* diml_f en_r) 2 3) list_r)))
  952.        (setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
  953.        )
  954.      )
  955.    )
  956. (setq n(1+ n))
  957. )
  958.       (setq list_r_n(length list_r)
  959.      n 0)
  960.       (repeat list_r_n
  961. (setq te_r(nth n list_r)
  962.        r_n 0
  963.        n1 0)
  964. (repeat ssa_n
  965.    (setq en(ssname ssa n1)
  966.   en_r(cdr(assoc 40 (entget en))))
  967.    (if(= te_r (rtos (* diml_f en_r) 2 3))
  968.      (setq r_n(1+ r_n)
  969.     r_pt(cdr(assoc 10 (entget en))))
  970.      )
  971.    (setq n1(1+ n1))
  972.    )
  973. (setq pt1(getpoint r_pt "\n翴匡ゅ癬翴 :")
  974.        pt0(polar r_pt (angle r_pt pt1) (/ (atof te_r) diml_f)))
  975. (if(= "." (substr te_r 1 1))
  976.    (setq te1 "R0")
  977.    (setq te1 "R")
  978.    )
  979. (if(= r_n 1)
  980.    (setq te(strcat te1 te_r))
  981.    (setq te(strcat (rtos r_n 2 0) "-" te1 te_r))
  982.    )
  983. (if(> (car pt1) (car pt0))
  984.    (setq pt2(polar pt1 0 0.5))
  985.    (setq pt2(polar pt1 pi 0.5))
  986.    )  
  987. (command "leader" pt0 pt1 "" te "")
  988. (setq n(1+ n))
  989. )
  990.       )
  991.     )
  992.   (if(> ssl_n 0)
  993.     (progn
  994.       (setq ssc(ssadd)
  995.      list_c '()
  996.      n 0)
  997.       (repeat ssl_n
  998. (setq en(ssname ssl n)
  999.        en_ps(cdr(assoc 10 (entget en)))
  1000.        en_pe(cdr(assoc 11 (entget en)))
  1001.        dx(abs(- (car en_ps) (car en_pe)))
  1002.        dy(abs(- (cadr en_ps) (cadr en_pe))))
  1003. (if(equal dx dy 0.001)
  1004.    (progn
  1005.      (ssadd en ssc)
  1006.      (if(null (setq chk_c(member (rtos (* diml_f dx) 2 1) list_c)))
  1007.        (setq list_c(cons (rtos (* diml_f dx) 2 1) list_c))
  1008.        )
  1009.      )
  1010.    )
  1011. (setq n(1+ n))
  1012. )
  1013.       (if(> (setq list_c_n(length list_c)) 0)
  1014. (progn
  1015.    (setq n 0)
  1016.    (repeat list_c_n
  1017.      (setq te_c(nth n list_c)
  1018.     ssc_n(sslength ssc)
  1019.     n1 0
  1020.     c_n 0)
  1021.      (repeat ssc_n
  1022.        (setq en(ssname ssc n1)
  1023.       en_ps(cdr(assoc 10 (entget en)))
  1024.       en_pe(cdr(assoc 11 (entget en)))
  1025.       dx(abs(- (car en_ps) (car en_pe)))
  1026.       )
  1027.        (if(= te_c (rtos (* diml_f dx) 2 1))
  1028.   (setq c_n(1+ c_n)
  1029.         c_pt(list (/ (+ (car en_ps) (car en_pe)) 2) (/ (+ (cadr en_ps) (cadr en_pe)) 2))
  1030.         )
  1031.   )
  1032.        (setq n1(1+ n1))
  1033.        )
  1034.      (setq pt1(getpoint c_pt "\n翴匡ゅ癬翴 :"))
  1035.      (if(= "." (substr te_c 1 1))
  1036.        (setq te1 "C0")
  1037.        (setq te1 "C")
  1038.        )
  1039.      (if(= c_n 1)
  1040.        (setq te(strcat te1 te_c))
  1041.        (setq te(strcat (rtos c_n 2 0) "-" te1 te_c))
  1042.        )
  1043.      (if(> (car pt1) (car c_pt))
  1044.        (setq pt2(polar pt1 0 0.5))
  1045.        (setq pt2(polar pt1 pi 0.5))
  1046.        )     
  1047.      (command "leader" c_pt pt1 "" te "")
  1048.      (setq n(1+ n))
  1049.      )
  1050.    )
  1051. )
  1052.       )
  1053.     )
  1054.   (if sst
  1055.     (command "erase" sst "")
  1056.     )
  1057.   (setq *error* olderr)
  1058.   (command "undo" "e")
  1059.   (setvar "cmdecho" orig_cmd)  
  1060.   (setvar "osmode" orig_osm)
  1061.   (setvar "orthomode" orig_orth)
  1062.   (setvar "clayer" orig_lay)
  1063.   (prin1)
  1064.   )
  1065. ;;;(ex_pl)
  1066. (defun ex_pl(/ sst_n en en_type n)
  1067.   (command "-layer" "m" "temp-user" "c" "47" "temp-user" "lt" "hidden" "temp-user" "")
  1068.   (command "copy" ssp "" (list 0 0) (list 0 0))
  1069.   (command "change" ssp "" "p" "la" "temp-user" "")
  1070.   (command "explode" ssp)
  1071.   (setq sst(ssget "x" '((8 . "TEMP-USER"))))
  1072.   (setq sst_n(sslength sst)
  1073. n 0)
  1074.   (repeat sst_n
  1075.     (setq en(ssname sst n)
  1076.    en_type(cdr(assoc 0 (entget en))))
  1077.     (cond((= "ARC" en_type) (ssadd en ssa))
  1078.   ((= "LINE" en_type) (ssadd en ssl))
  1079.   )
  1080.     (setq n(1+ n))
  1081.     )
  1082.   (setvar "clayer" orig_lay)
  1083.   (prin1)
  1084. )
  1085. (princ "\n*** 欢迎使用冲模设计软件,快捷功能已成功加载 *** <><><><> ***");(setq t tt))
回复

使用道具 举报

dhy
 楼主| 发表于 2015-12-26 12:10:18 来自手机 | 显示全部楼层
耐心等待
回复 支持 反对

使用道具 举报

dingtiedt
发表于 2015-12-26 13:12:02 | 显示全部楼层
不知道是不是改变小数点的位数，如果是，第528和559行中第二个“2”，就是控制小数点的位数
回复 支持 反对

使用道具 举报

dhy
 楼主| 发表于 2015-12-26 15:49:00 来自手机 | 显示全部楼层
不是这个问题，是标注出来的数是两位小数，多少有些我要手动改一位小数，有些要改三位小数的，可以改不了，不知道为什么。正常手工标的数是可以随意改的
回复 支持 反对

使用道具 举报

知行ooo李肖坪
发表于 2015-12-26 18:56:14 | 显示全部楼层
我也在等待……………………
回复 支持 反对

使用道具 举报

dhy
 楼主| 发表于 2015-12-26 21:13:17 | 显示全部楼层
                                                                    
回复 支持 反对

使用道具 举报

dhy
 楼主| 发表于 2015-12-28 22:10:24 | 显示全部楼层
高手都冷得躲被窝了，竟然没有人指点一下
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-21 01:29 , Processed in 0.216459 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表