[分享]通用函数

luchangliang

刚开始直接点，下不下来

后来发现要用右键另存为才能下

奇怪奇怪

jh1005

谢谢分享

luckier

感谢分享，在慢慢探索中

yue143

不错了。。。支持一下

xyp1964

;; 相同内容文字按上→下→左→右相连线
(defun c:test766 (/ s1 ss i ptn)
  (cmdla0)
  (if (and (setq s1 (car (entsel "\n请选取要连线的其中一个文字: ")))
    (= (xyp-get-dxf 0 s1) "TEXT")
      )
    (progn
      (prompt "\n框选所要连线的范围: ")
      (setq ss (ssget (list '(0 . "TEXT") (cons 1 (xyp-get-dxf 1 s1))))
     i -1
     ptn '()
      )
      (setvar "osmode" 0)
      (xyp-MkLaCo "TEST" 1)
      (while (setq s1 (ssname ss (setq i (1+ i))))
 (setq ptn (cons (xyp-get-dxf 10 s1) ptn))
      )
      (if ptn
 (xyp-Entmake-lwPolyline (xyp-Sort-PListByXYZ ptn) nil)
      )
    )
  )
  (cmdla1)
)

xyp1964

;; 对话框测试
(defun c:test758 ()
  (setq klst '("bo0" "bo1" "bo2" "bo3" "bo4" "bo5" "bo6" "bo7" "bo8" "bo9"))
  (defun aaa ()
    (xyp-Dcl-Gettile klst)
    (defun mt (key lst / a)
      (cond ((= key "1") (foreach a lst (mode_tile a 0)))
     ((= key "0") (foreach a lst (mode_tile a 1)))
      )
    )
    (mt bo0 '("t00" "t01"))
    (mt bo1 '("t10" "t11"))
    (mt bo2 '("t20" "t21"))
    (mt bo3 '("t30" "t31"))
    (mt bo4 '("t40" "t41"))
    (mt bo5 '("t50" "t51"))
    (mt bo6 '("t60" "t61"))
    (mt bo7 '("t70" "t71"))
    (mt bo8 '("t80" "t81"))
    (mt bo9 '("t90" "t91"))
  )
  (defun bbb ()
    (foreach a klst (set_tile a "1"))
    (aaa)
  )
  (defun ccc ()
    (foreach a klst (set_tile a "0"))
    (aaa)
  )
  (xyp-initSet
    '(bo0 t00 t01 bo1 t10 t11 bo2 t20 t21 bo3 t30 t31 bo4 t40 t41 bo5 t50 t51 bo6 t60 t61 bo7 t70
      t71 bo8 t80 t81 bo9 t90 t91 r1 r2 r3)
    '("0" "" "" "0" "" "" "0" "" "" "0" "" "" "0" "" "" "0" "" "" "0" "" "" "0" "" "" "0" "" "" "0"
      "" "" "1" "0" "0")
  )
  (setq Ilst '((nil nil ":row{")
        ("bo0" "dist0" "bool" "(aaa)")
        ("t00" "" "str" "10")
        ("t01" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo1" "dist1" "bool" "(aaa)")
        ("t10" "" "str" "10")
        ("t11" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo2" "dist2" "bool" "(aaa)")
        ("t20" "" "str" "10")
        ("t21" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo3" "dist3" "bool" "(aaa)")
        ("t30" "" "str" "10")
        ("t31" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo4" "dist4" "bool" "(aaa)")
        ("t40" "" "str" "10")
        ("t41" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo5" "dist5" "bool" "(aaa)")
        ("t50" "" "str" "10")
        ("t51" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo6" "dist6" "bool" "(aaa)")
        ("t60" "" "str" "10")
        ("t61" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo7" "dist7" "bool" "(aaa)")
        ("t70" "" "str" "10")
        ("t71" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo8" "dist8" "bool" "(aaa)")
        ("t80" "" "str" "10")
        ("t81" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bo9" "dist9" "bool" "(aaa)")
        ("t90" "" "str" "10")
        ("t91" "" "str" "10")
        (nil nil "}")
        (nil nil ":row{")
        ("bt1" "全选" "button1" "(bbb)")
        ("bt2" "全部取消" "button1" "(ccc)")
        (nil nil "}")
        (nil nil ":boxed_radio_row{label=\"操作\";")
        ("r1" "默认" "radio")
        ("r2" "代替" "radio")
        ("r3" "插入" "radio")
        (nil nil "}")
        (nil nil "user" "(aaa)")
       )
  )
  (if (= (xyp-Dcl-Init Ilst "【整体替换】" t) 1)
    (princ "TEST-OK")
  )
)

xyp1964

;; 保留数字文本大值
(defun c:test765 ()
  (CMDLA0)
  (setq ss  (ssget '((0 . "TEXT")))
 lst '()
 i   -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (if (setq b (xyp-get-dxf 1 s1))
      (setq lst (cons (list b s1) lst))
    )
  )
  (if lst
    (foreach a (cdr
   (vl-sort lst
     '(lambda (e1 e2) (> (distof (car e1)) (distof (car e2))))
   )
        )
      (xyp-erase (cadr a))
    )
  )
  (CMDLA1)
)

xyp1964

;; 算式文本计算
(defun c:test767 (/ ss i s1 tx a)
  (cmdla0)
  (xyp-initSet '(INT) '(3))
  (SETQ INT (UINT 5 "" "计算精度" INT))
  (if (not (member "geomcal.arx" (arx)))
    (arxload "geomcal.arx")
  )
  (setq ss (ssget '((0 . "text")))
 i  -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq tx (xyp-get-dxf 1 s1))
    (if (setq a (c:cal tx))
      (xyp-SubUpd s1 1 (strcat tx " = " (rtos a 2 INT)))
    )
  )
  (cmdla1)
)

xyp1964

工具箱界面：

xyp1964

图层函数：
【函数】: XYP-MkLaCo
【功能】: 图层颜色格式化输入
【语法】: (XYP-MKLACO 层名 颜色号)
(defun xyp-MkLaCo (LayerName LayerColor)
  (if (= (Tblsearch "layer" LayerName) nil)
    (Command "layer" "m" LayerName "c" LayerColor LayerName "")
    (Command "layer" "t" LayerName "s" LayerName "c" LayerColor LayerName "")
  )
  (setvar "celtype" "ByLayer")
  (princ)
)
(defun mkla (LayerName LayerColor)
  (xyp-mkLaCo LayerName LayerColor)
)