本帖最后由 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)
)
高科技 mark一下
请院长提供一下，这些函数：xyp-MkLaCoxyp-Offsetxyp-Vertexsxyp-SSelEntnext
新来的 看到这个牛贴好多函数源码
请院长提供一下 xyp-count1
;; 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)
)
院长，在别的帖子看到你发这个，新人非常想看看源码学习学习！
;; ep-sjxz(神经选择)
支持院长，支持源码
学习了！！！
;; 表按子表第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
)