社区 › AutoLISP/Visual LISP 编程技术 › 【e派】工具箱函数再揭秘及应用实例

yoyoho 发表于 2012-7-21 07:53:38

感谢 xyp1964 版主分享函数!

smartstar 发表于 2012-7-21 08:01:28

支持院长。

xiaxiang 发表于 2012-7-21 08:08:38

连院长都打算开源了，别人的代码还有捂着的必要吗

pzweng 发表于 2012-7-21 08:08:40

学习了,

longer1000 发表于 2012-7-21 08:28:45

支持院长，支持源码

chpmould 发表于 2012-7-21 08:38:19

very good!
LISP open-source moment.

cable2004 发表于 2012-7-21 08:38:47

强烈支持院长！

xiaoyingzi 发表于 2012-7-21 09:08:44

院长的源码，来学习

xyp1964 发表于 2012-7-21 09:12:54

本帖最后由 xyp1964 于 2020-11-19 23:30 编辑

;; 先来个伪源码的看看效果

;; zttc(总图停车)
(defun c:zttc (/ ilst ll1 ll2)
(cmdla0)
(defun main-pro (/ ss i s1 an w l ss dl dw i num ptn ptn1 ptn2 pt s2 n1 tx)
    (princ "\n选择曲线: ")
    (if (< ang 45)
      (setq an 90
   w(+ leng 0.5)
   l(- wide 1)
      )
      (setq an ang
   wwide
   lleng
      )
    )
    (setq ss(ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))
   dl(+ l (* w (xyp-TAN (xyp-d2r (- 90 an)))))
   dw(/ w (sin (xyp-d2r an)))
   i   -1
   num 0
    )
    (while (setq s1 (ssname ss (setq i (1+ i))))
      (xyp-Group0)
      (setq ptn (xyp-CurveDivDistBetweenPtn s1 dw))
      (foreach ptn1 ptn
(xyp-MkLaCo "总图停车" 8)
(foreach pt ptn1
   (setq s2 (xyp-Faxian s1 pt dl))
   (xyp-rotate s2 pt (- an 90))
)
(if (= bo1 "1")
   (progn
   (xyp-MkLaCo "总图停车数量" 4)
   (setq pt(xyp-Get-RightPoint (car ptn1) (last ptn1) (* l 0.5))
    n1(- (length ptn1) 1)
    num (+ n1 num)
    tx(itoa n1)
    s2(xyp-Text 5 pt tx)
   )
   )
)
      )
      (xyp-Group1)
    )
    (if (= bo1 "1")
      (progn
(xyp-Text 5 '(0 0) (strcat "停车数量 ＝ " (itoa num)))
(xyp-GrreadMove (entlast) '(0 0))
      )
    )
)
(setq ll1 '(wide leng ang bo1)
ll2 '(3. 5. 90. "1")
)
(defun ajbcs () (xyp-Multiple-Settile ll1 ll2))
(xyp-initSet ll1 ll2)
(setq ilst '(("k0" "" "imagebutton" "-2" "24" "zongtutingche" "(princ)")
      "spacer;"
      ("" "车位参数" ":boxed_column{")
      ("wide" "宽度(W)" "real" "8")
      ("leng" "长度(L)" "real" "8")
      ("ang" "角度(a)" "real" "8")
      "spacer;"
      ("bo1" "标数量" "bool")
      "spacer;"
      "}"
      "spacer;"
      ("jbcs" "缺省参数" "button1" "(ajbcs)")
      "spacer;"
      "ioc"
       )
)
(if (= (xyp-Dcl-Init Ilst "【总图停车】" t) 1)
    (main-pro)
)
(cmdla1)
)

xyp1964 发表于 2012-7-21 09:31:05

本帖最后由 xyp1964 于 2020-11-19 23:30 编辑


;; CheckPtn 删除重复点表 (CheckPtn ptn 500)
(defun CheckPtn (ptn fuzz / lst p1 lst-t pt)
(setq lst '())
(while (>= (length ptn) 1)
    (setq p1 (car ptn)
   ptn (cdr ptn)
   lst (cons p1 lst)
   lst-t '()
    )
    (foreach pt ptn
      (if (>= (distance p1 pt) fuzz)
(setq lst-t (cons pt lst-t))
      )
    )
    (setq ptn (reverse lst-t))
)
lst
)
;; 实例：优化多段线，长度小于500的顶点取消
(defun c:tt ()
(setq s1(car (entsel "\n选择多段线: "))
ptn (xyp-get-Vertexs s1 0)
ptn (CheckPtn ptn 500)
)
(xyp-Entmake-lwPolyline ptn nil)
(princ)
)

查看完整版本: 【e派】工具箱函数再揭秘及应用实例