[分享]：【实用程序汇总】test000系列！

xyp1964 · 发表于 2008-12-29 22:11:14

效果

asdfzxc · 发表于 2009-1-12 10:14:12

好好好好好好好

myid2001 · 发表于 2009-1-22 19:28:22

多谢了下来试试看

myiiid · 发表于 2009-1-27 13:24:32

直接拖进去。

five321 · 发表于 2009-2-12 19:28:52

不错，这对我很有用的程序

xyp1964 · 发表于 2009-2-14 19:44:26

[FONT=courier new];; 数据文本文件写图
;; 格式：520 1572 1.07
(defun c:test759 ()
(if (setq fn (getfiled "\nxy file name of data" "数据文件" "txt" 8))
(progn
(setq fo (open fn "r"))
(while (setq str (read-line fo))
(setq lst (xyp-get-HzEngNum str 3)
tx (caddr lst)
pt0 (list (atof (car lst)) (atof (cadr lst)))
)
(command "text" "non" pt0 "2" "0" tx)
)
(close fo)
)
)
(princ)
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:44:52

[FONT=courier new];|
dcl对话框参考:
程式化对话框设计
幻灯片显示
|;
(defun c:test760 ()
(CMDLA0)
(defun aaa ()
(xyp-Dcl-Gettile '("k1" "k2" "k3" "k4"))
(cond ((= k1 "1") (xyp-show-sld "k0" "acad(stone01)"))
((= k2 "1") (xyp-show-sld "k0" "acad(stone03)"))
((= k3 "1") (xyp-show-sld "k0" "acad(stone04)"))
((= k4 "1") (xyp-show-sld "k0" "acad(stone05)"))
)
)
(xyp-initSet
'(k1 k2 k3 k4 kd gd)
'("1" "0" "0" "0" 100.0 100.0)
)
(setq Ilst '(("k0" nil "imagebutton" "-2" "36" "AIONIC" "(XYP-ABOUTME)")
(nil nil "spacer;")
(nil nil ":boxed_radio_row{label="设计样式";")
("k1" "1" "radio" "(aaa)")
("k2" "2" "radio" "(aaa)")
("k3" "3" "radio" "(aaa)")
("k4" "4" "radio" "(aaa)")
(nil nil "}")
("kd" "宽度" "real" "10")
("gd" "高度" "real" "10")
(nil nil "user" "(aaa)")
(nil nil "spacer;")
)
)
(if (= (xyp-Dcl-Init Ilst "【图像辅助设计】" t) 1)
(princ)
)
(CMDLA1)
)[/FONT]

[FONT=courier new];| 
dcl对话框参考: 
程式化对话框设计 
幻灯片显示 
|; 
(defun c:test760 () 
  (CMDLA0) 
  (defun aaa () 
    (xyp-Dcl-Gettile '("k1" "k2" "k3" "k4")) 
    (cond ((= k1 "1") (xyp-show-sld "k0" "acad(stone01)")) 
          ((= k2 "1") (xyp-show-sld "k0" "acad(stone03)")) 
          ((= k3 "1") (xyp-show-sld "k0" "acad(stone04)")) 
          ((= k4 "1") (xyp-show-sld "k0" "acad(stone05)")) 
    ) 
  ) 
  (xyp-initSet 
    '(k1 k2 k3 k4 kd gd) 
    '("1" "0" "0" "0" 100.0 100.0) 
  ) 
  (setq        Ilst '(("k0" nil "imagebutton" "-2" "36" "AIONIC" "(XYP-ABOUTME)") 
               (nil nil "spacer;") 
               (nil nil ":boxed_radio_row{label="设计样式";") 
               ("k1" "1" "radio" "(aaa)") 
               ("k2" "2" "radio" "(aaa)") 
               ("k3" "3" "radio" "(aaa)") 
               ("k4" "4" "radio" "(aaa)") 
               (nil nil "}") 
               ("kd" "宽度" "real" "10") 
               ("gd" "高度" "real" "10") 
               (nil nil "user" "(aaa)") 
               (nil nil "spacer;") 
              ) 
  ) 
  (if (= (xyp-Dcl-Init Ilst "【图像辅助设计】" t) 1) 
    (princ) 
  ) 
  (CMDLA1) 
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:46:06

[FONT=courier new];; 多段线圆弧半径
(defun c:test761 ()
(princ "\n选择圆弧: ")
(command "dim" "rad" pause "" "" "e")
(setq s1 (entlast))
(setq r (cdr (assoc 42 (entget s1))))
(entdel s1)
(princ)
(alert (strcat "半径＝" (rtos r 2 4)))
(princ)
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:46:48

[FONT=courier new];; 相交线的平分面
(defun c:test762 ()
(CMDLA0)
(setq s1 (car (entsel "\n选择: ")))
(setq s2 (car (entsel "\n选择: "))
p1 (xyp-get-dxf 10 s1)
p2 (xyp-get-dxf 11 s1)
p3 (xyp-get-dxf 10 s2)
p4 (xyp-get-dxf 11 s2)
p5 (inters p1 p2 p3 p4 nil)
rad1 (angle p1 p2)
rad2 (angle p3 p4)
p6 (polar p5 rad1 100)
p7 (polar p5 rad2 100)
p8 (xyp-get-MidPoint p6 p7)
)
(command "circle" "non" p5 200)
(command "rotate3d" (entlast) "" "2" p5 p8 90)
(CMDLA1)
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:48:55

[FONT=courier new];; 双多段线中间插入中线
(defun c:test763 ()
(CMDLA0)
(xyp-MkLaCo "中心线" 1)
(setq e1 (entsel "\n选择: ")
slst (xyp-ATSel e1)
ptn1 (xyp-get-Vertexs (car slst) 0)
ptn2 (xyp-get-Vertexs (cadr slst) 0)
i 0
ptn '()
)
(foreach pt ptn1
(setq pt1 (nth i ptn2)
pt2 (xyp-get-MidPoint pt pt1)
i (1+ i)
ptn (cons pt2 ptn)
)
)
(xyp-Entmake-lwPolyline ptn nil)
(CMDLA1)
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:49:21

[FONT=courier new];; 平行线之中心线
(defun c:test764 ()
(CMDLA0)
(xyp-MkLaCo "中心线" 1)
(while (setq s1 (entsel "\nLine线: "))
(setq ptn (xyp-get-MidLinePT s1))
(xyp-add-line (car ptn) (cadr ptn))
)
(CMDLA1)
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:49:59

[FONT=courier new];; 保留数字文本大值
(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)
)[/FONT]

xyp1964 · 发表于 2009-2-14 19:59:53

[FONT=courier new];; 相同内容文字按上→下→左→右相连线
(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)
)[/FONT]

夜精灵 · 发表于 2009-2-18 21:32:43

能不能用都先谢谢咯

dtlin · 发表于 2009-2-26 21:16:11

谁发一个多个文本同时加减乘除一个数值的LSP 代码上来用用

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

[程序发布] [分享]：【实用程序汇总】test000系列！

浏览过的版块