给圆加代码程序

greyzxy

一个给圆加代码的插件，有一个小问题，按s获取圆颜色后，文字代码的颜色并没有跟随，不知是哪个参数设置有问题？这个插件很好用，希望有大神帮忙修改一下，，
(defun c:dx (/ *error*)                                ;预定代码自动填写
  (command "_.undo" "be")
  (vl-load-com)
(defun *error* (msg)
    (if OS
      (setvar "osmode" OS)
    )
    (setvar "cmdecho" 1)
  )
  (setq kbwb0 (list (list 0)))                ;创建空白表
  (setq b '(0))                                ;b是建立一个空表
  (setq b1 '(0))                        ;b1是建立一个空表
  (setq gs 0)
  (setq gs1 "添加个数:")
  (setq myacad (vlax-get-acad-object))
  (setq mydoc (vla-get-ActiveDocument myacad))
  (setq myms (vla-get-ModelSpace mydoc))
  (setq v2 (getvar "cmdecho"))                ;获取当前的普通命令提示状态，将其赋值给V2
  (setq v3 (getvar "blipmode"))                ;获取当前的光标痕迹显示状态，将其赋值给变量V3
  (setvar "cmdecho" 0)                        ;不显示普通命令的提示
  (setvar "blipmode" 0)
  (setq os (getvar "osmode"))
  (setq n1 (getvar "DIMTXT"))
  (setq n2 (getvar "DIMSCALE"))
  (setq n3 (* n1 n2))

  (setvar "osmode" 0)
  (setq ucs (getvar "UCSORG"))
  (prompt "\n选择范围: ")
  (setq ss (ssget))                        ;创建一个选择集
  (setq n (sslength ss))                ;计算出此选择集的字符
  (setq k 0)
  (while (< k N)
    (setq wz1 (ssname ss k))
    (setq wz2 (entget wz1))
    (setq wz3 (vlax-ename->vla-object wz1))
    (setq wz4 (vla-get-ObjectName wz3))
    (if        (= wz4 "AcDbMText")
      (progn
        (setq wz5 (vla-get-TextString wz3))
        (setq kbwb0 (cons wz5 kbwb0))
      )
      (progn
      )
    )
    (setq k (+ 1 k))
  )
  (setq kbwb1 (cdr (reverse kbwb0)))        ;所有文字表
  (setq kbwb2 (aaa kbwb1))


  (setq e9 (entsel "请选择一个对象: "))
  (setq tk (car e9))
  (setq e10 (vlax-ename->vla-object tk))
  (setq s1 (vla-get-ObjectName e10))
                                        ;圆特征
  (setq s2 (vla-get-Radius e10))
                                        ;圆的半径
  (setq s3 (vla-get-Linetype e10))
                                        ;圆的线性
  (setq s4 (vla-get-PlotStyleName e10))
                                        ;圆的线的颜色
  (setq sp (getstring "\n请确认输入的代码:"))
  (setq k 0)
  (setq wn (length kbwb2))
  (while (< k wn)
    (setq kbwb3 (nth k kbwb2))
    (if        (= kbwb3 sp)
      (progn

        (initget 1 "Yes No")
        (setq x (getkword "代码重复是否继续使用此代码[是(Y)/否(N)]： "))
        (if (= x "Yes")
          (progn
            (setq k wn)
          )
          (progn
            (setq sp (getstring "\n请重新输入的代码:"))
            (setq k 0)
          )
        )

      )
      (progn
      )
    )
    (setq k (+ 1 k))
  )





  (setq jj (getstring "\n请输入颜色数值[读取对象(S)："))
  (if (= jj "S")
    (progn
      (setq ee (entsel "\n颜色读取对象: "))
      (setq ee1 (car ee))
      (setq ee2 (entget ee1))
      (setq ee3 (assoc 62 ee2))
      (setq ee4 (cdr ee3))
      (setq s (strcase sp))                ;小写变成大写
      (setq k 0)
      (while (< k N)                        ;循环语句开头
        (setq ent1 (ssname ss k))
        (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
        (setq sus (vlax-ename->vla-object ent1))

        (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
        (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
        (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
        (if (= e3 s1)                        ;判断是否为圆
          (progn
            (setq e4 (vla-get-Radius sus)) ;圆的半径
            (if        (= e4 s2)                ;判断是圆半径
              (progn
                (if (= e5 s3)                ;判断是圆线型
                  (progn
                    (if        (= e8 s4)        ;判断是圆颜色
                      (progn
                        (setq e1 (vla-get-Center sus))
                        (setq
                          e2
                           (vlax-safearray->list (vlax-variant-value e1))
                        )                ;圆孔坐标
                        (setq x1 (car ucs))
                        (setq y1 (cadr ucs))
                        (setq x2 (car e2))
                        (setq y2 (cadr e2))
                        (setq x (- x2 x1)) ;圆孔的X坐标值
                        (setq y (- y2 y1)) ;圆孔的Y坐标值
                        (setq e6 (vla-get-Radius sus)) ;获取圆孔直径
                        (command "chprop" ent1 "" "C" ee4 "")
                        (setq e7 (+ 3 E6))
                        (setq P13 '(0))
                        (setq P14 (cons Y P13))
                        (setq P15 (cons X P14))
                        (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                        (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                        (setq gs (+ gs 1))
                      )
                    )
                  )
                )
              )
            )
          )
        )
        (setq K (+ 1 K))
      )                                        ;结束循环语句
    )
    (progn
      (if (= jj "s")
        (progn
          (setq ee (entsel "\n颜色读取对象: "))
          (setq ee1 (car ee))
          (setq ee2 (entget ee1))
          (setq ee3 (assoc 62 ee2))
          (setq ee4 (cdr ee3))
          (setq s (strcase sp))                ;小写变成大写
          (setq k 0)
          (while (< k N)                ;循环语句开头
            (setq ent1 (ssname ss k))
            (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
            (setq sus (vlax-ename->vla-object ent1))

            (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
            (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e3 s1)                ;判断是否为圆
              (progn
                (setq e4 (vla-get-Radius sus)) ;圆的半径
                (if (= e4 s2)                ;判断是圆半径
                  (progn
                    (if        (= e5 s3)        ;判断是圆线型
                      (progn
                        (if (= e8 s4)        ;判断是圆颜色
                          (progn
                            (setq e1 (vla-get-Center sus))
                            (setq
                              e2
                               (vlax-safearray->list
                                 (vlax-variant-value e1)
                               )
                            )                ;圆孔坐标
                            (setq x1 (car ucs))
                            (setq y1 (cadr ucs))
                            (setq x2 (car e2))
                            (setq y2 (cadr e2))
                            (setq x (- x2 x1)) ;圆孔的X坐标值
                            (setq y (- y2 y1)) ;圆孔的Y坐标值
                            (setq e6 (vla-get-Radius sus))
                                        ;获取圆孔直径
                            (command "chprop" ent1 "" "C" ee4 "")
                            (setq e7 (+ 3 E6))
                            (setq P13 '(0))
                            (setq P14 (cons Y P13))
                            (setq P15 (cons X P14))
                            (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                            (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                            (setq gs (+ gs 1))
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq K (+ 1 K))
          )

        )
        (progn
          (setq s (strcase sp))                ;小写变成大写
          (setq k 0)
          (while (< k N)                ;循环语句开头
            (setq ent1 (ssname ss k))
            (setq ent2 (entget ent1))
                                        ;获取第一个选择集的图元名
            (setq sus (vlax-ename->vla-object ent1))

            (setq e3 (vla-get-ObjectName sus))
                                        ;圆特征
            (setq e5 (vla-get-Linetype sus))
                                        ;；圆的线性
            (setq e8 (vla-get-PlotStyleName sus))
                                        ; 圆的线的颜色
            (if        (= e3 s1)                ;判断是否为圆
              (progn
                (setq e4 (vla-get-Radius sus)) ;圆的半径
                (if (= e4 s2)                ;判断是圆半径
                  (progn
                    (if        (= e5 s3)        ;判断是圆线型
                      (progn
                        (if (= e8 s4)        ;判断是圆颜色
                          (progn
                            (setq e1 (vla-get-Center sus))
                            (setq
                              e2
                               (vlax-safearray->list
                                 (vlax-variant-value e1)
                               )
                            )                ;圆孔坐标
                            (setq x1 (car ucs))
                            (setq y1 (cadr ucs))
                            (setq x2 (car e2))
                            (setq y2 (cadr e2))
                            (setq x (- x2 x1)) ;圆孔的X坐标值
                            (setq y (- y2 y1)) ;圆孔的Y坐标值
                            (setq e6 (vla-get-Radius sus))
                                        ;获取圆孔直径
                            (command "chprop" ent1 "" "C" jj "")
                            (setq e7 (+ 3 E6))
                            (setq P13 '(0))
                            (setq P14 (cons Y P13))
                            (setq P15 (cons X P14))
                            (setq P12 (polar P15 (* 0.25 pi) E7))
                                        ;字码位置坐标
                                        ;(setq P12 (reverse (cdr (reverse P12))))
                            (setq b (cons P12 b))
                                        ;在表对的前面添加字码位置内容
                            (setq gs (+ gs 1))
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq K (+ 1 K))
          )
        )
      )
    )
  )

                                        ;(setq b (cdr (reverse b)))
  (setq k 0)
  (setq b (vl-remove 0 b));去除表里面的0元素
(setq b1 (delsame b 0.0001));调用子函数DELSAME删除重复元素
  (setq k 0)
  (setq n (length b1))
  (while (< k n)                        ;n是表元素的数目
    (setq P12 (nth K b1))
    (COMMAND "MTEXT" P12 "H" n3 P12 S "")
    (setq K (+ 1 K))
  )
  (setvar "osmode" OS)                        ;恢复目标捕捉的原来的状态
  (setvar "blipmode" v3)                ;恢复光标痕迹原来的显示状态
  (setvar "osmode" 16383)                ;捕捉对象设置
  (setvar "osmode" 16383)
  (setq gs4 (- gs n))                        ;重复的个数
  (setq gs4 (rtos gs4 2 2))
  (setq n (rtos n 2 2))
  (setq gs5 "已删除重复文字：")
  (setq gs3 (strcat gs1 n gs5 gs4))
  (alert gs3)
  (command "_.undo" "E")
  (setvar "cmdecho" v2)                        ;恢复普通命令提示原来的显示状态显示状态

)

ketxu

Can you run it and capture F2 screen whenever poblem ?

叮咚

程序中少了一个 aaa的自定义函数，没办法测试

hnzkhyyl

没有对同心圆进行筛选

greyzxy

hnzkhyyl 发表于 2019-8-25 20:32
没有对同心圆进行筛选

不怎么懂，怎么修改呀

greyzxy

叮咚 发表于 2019-8-23 20:24
程序中少了一个 aaa的自定义函数，没办法测试

这个代码我另一个帖子里有,你去看看

vladimirputin

非常不错的资料，谢谢楼主分享啊的