【e派】工具箱函数再揭秘及应用实例

xyp1964 · 发表于 2017-8-4 23:37:22

本帖最后由 xyp1964 于 2017-11-20 21:42 编辑

;; ykhz(腰孔绘制)
(defun c:ykhz (/ ilst ll1 ll2)
(xyp-Start)
(defun main-pro (/ w1 p0 s0 p1 p2 p3 p4 dl1 dl2 w2 l0 pa)
(setq l0 (if (= bo0 "1")
(- leng wide)
leng
)
w1 (* wide 0.5)
w2 (- w1)
l1 (* l0 0.5)
)
(while (setq p0 (getpoint "\n中心基点<退出>: "))
(xyp-Group0)
(xyp-MkLaCo "腰孔" 4)
(setq s0 (entlast)
p1 (xyp-Pt2XY p0 (* l1 -1) w2)
p2 (xyp-Pt2XY p0 l1 w2)
p3 (xyp-Pt2XY p0 l1 w1)
p4 (xyp-Pt2XY p0 (* l1 -1) w1)
)
(xyp-line p1 p2)
(xyp-line p3 p4)
(xyp-Arc-3pt p3 (xyp-Mid2PtUp p3 p2 w1) p2)
(xyp-Arc-3pt p1 (xyp-Mid2PtUp p1 p4 w1) p4)
(xyp-PeditJoin (xyp-SSelEntnext s0) 0)
(if (= bo1 "1")
(progn
(xyp-MkLaCo "轴线" 1)
(setq dl1 (+ (* (+ l0 wide) 0.5) ll)
dl2 (+ w1 ll)
)
(xyp-line (xyp-Pt2X p0 (- dl1)) (xyp-Pt2X p0 dl1))
(xyp-line (xyp-Pt2Y p0 (- dl2)) (xyp-Pt2Y p0 dl2))
(xyp-line (xyp-Pt2XY p0 (* l1 -1) (* w2 0.5))
(xyp-Pt2XY p0 (* l1 -1) (* w1 0.5))
)
(xyp-line (xyp-Pt2XY p0 l1 (* w2 0.5))
(xyp-Pt2XY p0 l1 (* w1 0.5))
)
)
)
(cond ((= k3 "1")
(xyp-MkLaCo "Dim" 3)
(xyp-dim-hor
(xyp-Pt2X p4 w2)
(xyp-Pt2X p3 w1)
(xyp-Pt2Y p4 600)
)
(xyp-dim-Ver p1 p4 (xyp-Pt2X p1 (- (+ 600 w1))))
)
((= k2 "1")
(xyp-MkLaCo "Dim" 3)
(setq pa (xyp-Pt2Y p4 600))
(xyp-dim-hor p4 p3 pa)
(xyp-dim-Ver p1 p4 (xyp-Pt2X p1 (- (+ 600 w1))))
)
)
(if (/= ang 0)
(xyp-rotate (xyp-SSelEntnext s0) P0 ang)
)
(xyp-Group1)
)
)
(defun abo1 ()
(xyp-Dcl-Gettile '("bo1"))
(cond ((= bo1 "1")
(mode_tile "ll" 0)
(xyp-Show-Sld "k0" "xyp(yaokong02)")
)
((= bo1 "0")
(mode_tile "ll" 1)
(xyp-Show-Sld "k0" "xyp(yaokong01)")
)
)
)
(setq ll1 '(leng wide ang bo1 ll k1 k2 k3 bo0)
ll2 '(1000. 500. 0. "0" 200. "1" "0" "0" "0")
)
(defun ajbcs () (xyp-Multiple-Settile ll1 ll2))
(xyp-initSet ll1 ll2)
(setq ilst '(("k0" "" "imagebutton" "-2" "30" "xyp(yaokong01)" "(princ)")
"spacer;"
("" "参数" ":boxed_column{")
("leng" "腰孔长度" "real" "8")
("wide" "腰孔宽度" "real" "8")
("ang" "旋转角度" "real" "8")
"spacer;"
("bo0" "腰孔长度 = 外廓" "bool")
"spacer;"
"}"
("" "其它" ":boxed_column{")
":row{"
("bo1" "轴线出头" "bool" "(abo1)")
("ll" "" "real" "8")
"}"
"spacer;"
"}"
("" "尺寸标注" ":boxed_radio_row{")
("k1" "无" "radio")
("k2" "圆心" "radio")
("k3" "外廓" "radio")
"}"
("jbcs" "缺省参数" "button1" "(ajbcs)")
("" "" "user" "(abo1)")
)
)
(if (= (xyp-Dcl-Init Ilst "【腰孔绘制】V17.8.3" t) 1) ;V11.10.13
(main-pro)
)
(xyp-End)
)

;; ykhz(腰孔绘制) 
(defun c:ykhz (/ ilst ll1 ll2) 
  (xyp-Start) 
  (defun main-pro (/ w1 p0 s0 p1 p2 p3 p4 dl1 dl2 w2 l0 pa) 
    (setq l0 (if (= bo0 "1") 
               (- leng wide) 
               leng 
             ) 
          w1 (* wide 0.5) 
          w2 (- w1) 
          l1 (* l0 0.5) 
    ) 
    (while (setq p0 (getpoint "\n中心基点<退出>: ")) 
      (xyp-Group0) 
      (xyp-MkLaCo "腰孔" 4) 
      (setq s0 (entlast) 
            p1 (xyp-Pt2XY p0 (* l1 -1) w2) 
            p2 (xyp-Pt2XY p0 l1 w2) 
            p3 (xyp-Pt2XY p0 l1 w1) 
            p4 (xyp-Pt2XY p0 (* l1 -1) w1) 
      ) 
      (xyp-line p1 p2) 
      (xyp-line p3 p4) 
      (xyp-Arc-3pt p3 (xyp-Mid2PtUp p3 p2 w1) p2) 
      (xyp-Arc-3pt p1 (xyp-Mid2PtUp p1 p4 w1) p4) 
      (xyp-PeditJoin (xyp-SSelEntnext s0) 0) 
      (if (= bo1 "1") 
        (progn 
          (xyp-MkLaCo "轴线" 1) 
          (setq        dl1 (+ (* (+ l0 wide) 0.5) ll) 
                dl2 (+ w1 ll) 
          ) 
          (xyp-line (xyp-Pt2X p0 (- dl1)) (xyp-Pt2X p0 dl1)) 
          (xyp-line (xyp-Pt2Y p0 (- dl2)) (xyp-Pt2Y p0 dl2)) 
          (xyp-line (xyp-Pt2XY p0 (* l1 -1) (* w2 0.5)) 
                    (xyp-Pt2XY p0 (* l1 -1) (* w1 0.5)) 
          ) 
          (xyp-line (xyp-Pt2XY p0 l1 (* w2 0.5)) 
                    (xyp-Pt2XY p0 l1 (* w1 0.5)) 
          ) 
        ) 
      ) 
      (cond ((= k3 "1") 
             (xyp-MkLaCo "Dim" 3) 
             (xyp-dim-hor 
               (xyp-Pt2X p4 w2) 
               (xyp-Pt2X p3 w1) 
               (xyp-Pt2Y p4 600) 
             ) 
             (xyp-dim-Ver p1 p4 (xyp-Pt2X p1 (- (+ 600 w1)))) 
            ) 
            ((= k2 "1") 
             (xyp-MkLaCo "Dim" 3) 
             (setq pa (xyp-Pt2Y p4 600)) 
             (xyp-dim-hor p4 p3 pa) 
             (xyp-dim-Ver p1 p4 (xyp-Pt2X p1 (- (+ 600 w1)))) 
            ) 
      ) 
      (if (/= ang 0) 
        (xyp-rotate (xyp-SSelEntnext s0) P0 ang) 
      ) 
      (xyp-Group1) 
    ) 
  ) 
  (defun abo1 () 
    (xyp-Dcl-Gettile '("bo1")) 
    (cond ((= bo1 "1") 
           (mode_tile "ll" 0) 
           (xyp-Show-Sld "k0" "xyp(yaokong02)") 
          ) 
          ((= bo1 "0") 
           (mode_tile "ll" 1) 
           (xyp-Show-Sld "k0" "xyp(yaokong01)") 
          ) 
    ) 
  ) 
  (setq        ll1 '(leng wide ang bo1 ll k1 k2 k3 bo0) 
        ll2 '(1000. 500. 0. "0" 200. "1" "0" "0" "0") 
  ) 
  (defun ajbcs () (xyp-Multiple-Settile ll1 ll2)) 
  (xyp-initSet ll1 ll2) 
  (setq        ilst '(("k0" "" "imagebutton" "-2" "30" "xyp(yaokong01)" "(princ)") 
               "spacer;" 
               ("" "参数" ":boxed_column{") 
               ("leng" "腰孔长度" "real" "8") 
               ("wide" "腰孔宽度" "real" "8") 
               ("ang" "旋转角度" "real" "8") 
               "spacer;" 
               ("bo0" "腰孔长度 = 外廓" "bool") 
               "spacer;" 
               "}" 
               ("" "其它" ":boxed_column{") 
               ":row{" 
               ("bo1" "轴线出头" "bool" "(abo1)") 
               ("ll" "" "real" "8") 
               "}" 
               "spacer;" 
               "}" 
               ("" "尺寸标注" ":boxed_radio_row{") 
               ("k1" "无" "radio") 
               ("k2" "圆心" "radio") 
               ("k3" "外廓" "radio") 
               "}" 
               ("jbcs" "缺省参数" "button1" "(ajbcs)") 
               ("" "" "user" "(abo1)") 
              ) 
  ) 
  (if (= (xyp-Dcl-Init Ilst "【腰孔绘制】V17.8.3" t) 1) ;V11.10.13 
    (main-pro) 
  ) 
  (xyp-End) 
)

Lewis · 发表于 2017-9-7 13:32:41

高科技 mark一下

alexmai · 发表于 2017-11-1 22:38:00

请院长提供一下，这些函数：xyp-MkLaCo xyp-Offset xyp-Vertexs xyp-SSelEntnext

尒樣僮 · 发表于 2017-11-9 12:02:45

新来的看到这个牛贴好多函数源码

TPG辉 · 发表于 2017-11-20 09:59:20

请院长提供一下 xyp-count1

xyp1964 · 发表于 2017-11-20 21:41:38

;; dxby(单线百叶)
(defun c:dxby (/ Dlst ll1 ll2)
(xyp-Start)
(defun main-pro (/ i ss s1 p1 p3 p7 th nn dd s1)
(xyp-MkLaCo "普通方窗" 4)
(princ "\n选择矩形窗外框: ")
(setq i -1)
(if (setq ss (ssget '((0 . "*polyline") (90 . 4) (70 . 1))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-Group0)
(xyp-Offset s1 k-jk nil t nil)
(setq p1 (xyp-9pt s1 1)
p3 (xyp-9pt s1 3)
p7 (xyp-9pt s1 7)
th (- (distance p1 p7) (* k-jk 2))
nn
(fix (/ th k-vw))
dd (/ th nn 1.)
s1 (xyp-line (xyp-Pt2XY p1 k-jk (+ k-jk dd))
(xyp-Pt2XY p3 (- k-jk) (+ k-jk dd))
)
)
(xyp-ArrayRV s1 (1- nn) dd)
(xyp-Group1)
)
)
)
(xyp-initSet '(k-jk k-vw) '(100. 50.))
(setq Dlst '(("k0" "" "ib" "-2" "48" "xyp(ptfc01)" "(princ)")
("" "参数" ":boxed_column{")
("k-jk" "筋　宽" "real" "8")
("k-vw" "纵向宽度" "real" "8")
"spacer;"
"}"
"ioc"
)
)
(if (= (xyp-Dcl-Init Dlst "【单线百叶】V17.8.23" t) 1)
(main-pro)
)
(xyp-End)
)

;; dxby(单线百叶) 
(defun c:dxby (/ Dlst ll1 ll2) 
  (xyp-Start) 
  (defun main-pro (/ i ss s1 p1 p3 p7 th nn dd s1) 
    (xyp-MkLaCo "普通方窗" 4) 
    (princ "\n选择矩形窗外框: ") 
    (setq i -1) 
    (if        (setq ss (ssget '((0 . "*polyline") (90 . 4) (70 . 1)))) 
      (while (setq s1 (ssname ss (setq i (1+ i)))) 
        (xyp-Group0) 
        (xyp-Offset s1 k-jk nil t nil) 
        (setq p1 (xyp-9pt s1 1) 
              p3 (xyp-9pt s1 3) 
              p7 (xyp-9pt s1 7) 
              th (- (distance p1 p7) (* k-jk 2)) 
              nn 
                 (fix (/ th k-vw)) 
              dd (/ th nn 1.) 
              s1 (xyp-line (xyp-Pt2XY p1 k-jk (+ k-jk dd)) 
                           (xyp-Pt2XY p3 (- k-jk) (+ k-jk dd)) 
                 ) 
        ) 
        (xyp-ArrayRV s1 (1- nn) dd) 
        (xyp-Group1) 
      ) 
    ) 
  ) 
  (xyp-initSet '(k-jk k-vw) '(100. 50.)) 
  (setq        Dlst '(("k0" "" "ib" "-2" "48" "xyp(ptfc01)" "(princ)") 
               ("" "参数" ":boxed_column{") 
               ("k-jk" "筋　宽" "real" "8") 
               ("k-vw" "纵向宽度" "real" "8") 
               "spacer;" 
               "}" 
               "ioc" 
              ) 
  ) 
  (if (= (xyp-Dcl-Init Dlst "【单线百叶】V17.8.23" t) 1) 
    (main-pro) 
  ) 
  (xyp-End) 
)

ozc1352 · 发表于 2017-12-1 09:39:38

院长，在别的帖子看到你发这个，新人非常想看看源码学习学习！
;; ep-sjxz(神经选择)

362928018 · 发表于 2017-12-2 16:08:23

支持院长，支持源码

bzhyong · 发表于 2017-12-2 16:36:34

学习了！！！

xyp1964 · 发表于 2017-12-31 17:44:25

;; 表按子表第n位归类 (Count-Nth lst表 n位置)
;; (setq lst1 (Count-Nth lst 0)) 第一位为0
(defun Count-Nth (lst n / a lst1 tmp x)
(while lst
(setq a (car lst)
lst (cdr lst)
lst1 (vl-remove-if-not '(lambda (x) (equal (nth n x) (nth n a))) lst) ;相同
lst (vl-remove-if '(lambda (x) (equal (nth n x) (nth n a))) lst) ;不同
tmp (cons (cons a lst1) tmp)
)
)
tmp
)

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

[讨论] 【e派】工具箱函数再揭秘及应用实例

本帖子中包含更多资源

点评