Used Fun3
;;;获取点集ptlst中与点pt距离最近的点
(defun get-mindis-pt (ptlst pt)
(car
(vl-sort ptlst
(function (lambda (e1 e2)
(< (distance e1 pt) (distance e2 pt))
)
)
)
)
)
;;表项替代函数
(defun ch-lst (new i lst / j)
(if (numberp i)
(cond ((zerop i) (cons new (cdr lst)))
((> i 0)
(cons
(car lst)
(ch-lst
new
(1- i)
(cdr lst)
)
)
)
(T lst)
)
(progn
(setq j (cadr i)
i (car i)
)
(if j
(ch-lst (ch-lst new j (nth i lst)) i lst)
(ch-lst new i lst)
)
)
)
)
;;;转换选择集为表
(defun wjm_ss2lst (ss / i e lst)
(if (= (type ss) 'PICKSET)
(progn
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if (= (type e) 'ENAME) (setq lst (cons e lst)) nil)
)
lst
)
nil
)
)
;;;--------------------------------------------------------------------------------------;;;
;;;drwa-pline ;;;
;;;--------------------------------------------------------------------------------------;;;
;;;
;;;function: to make a polyline by code and return ename
;;;
;;;Variants:
;;;pl_list: the points list offered by order
;;;width : 0.0 or num, or a list like ((0.0 0.0) (0.0 20) (20 0.0)...),if nil it will getvar "plinewid" ,
;;; if it's length noteq d90 then wid41 and wid42 equal to 0.0 .
;;;d42_lst: 0.0 or num, or nil, if nil or it's length noteq d90 then d42 equal to 0.0 .
;;;
;;;lay_pl: layername, if nil it will getvar "CLAYER"
;;;
;;;color : color number, if it's -1 then getvar "COLOR" ellse set it by the given color number
;;;
;;;Prompt:
;;;If width list or d42_lst list is Exist , it's order must be same to the pl_list,
;;; otherwise it will take out a wrong polyline .
;;;
;;;Written By WJM and GSLS(SS),2010.06.30
;;;
(defun draw-pline
(pl_list width d42_lst lay_pl color d70
/ d90 i wid d42 wid40
wid41 en000 pb
)
(setq d90 (length pl_list)
pb '()
i 0
)
(cond ((and (listp width)
(listp d42_lst)
(= (length width) (length d42_lst) d90)
)
(foreach pt pl_list
(setq wid (nth i width)
d42 (nth i d42_lst)
wid40 (car wid)
wid41 (cadr wid)
pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 d42)
)
)
i (1+ i)
)
)
)
((and (or (numberp width) (null width))
(listp d42_lst)
(= (length d42_lst) d90)
)
(if (null width)
(setq wid40 (getvar "plinewid")
wid41 (getvar "plinewid")
)
(setq wid40 width
wid41 width
)
)
(foreach pt pl_list
(setq d42 (nth i d42_lst)
pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 d42)
)
)
i (1+ i)
)
)
)
((and (listp width)
(= (length width) d90)
(or (null d42_lst) (numberp d42_lst))
)
(if (null d42_lst)
(setq d42 0.0)
(setq d42 d42_lst)
)
(foreach pt pl_list
(setq wid (nth i width)
wid40 (car wid)
wid41 (cadr wid)
pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 d42)
)
)
i (1+ i)
)
)
)
(t
(if (numberp width)
(setq wid40 width
wid41 width
)
(setq wid40 0.0
wid41 0.0
)
)
(foreach pt pl_list
(setq pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 0.0)
)
)
)
)
)
)
(setq en000 (append (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8
(if (and lay_pl (/= lay_pl ""))
lay_pl
(getvar "CLAYER")
)
)
(cons 100 "AcDbPolyline")
(cons 90 d90)
(cons 70 d70)
)
pb
)
)
(if (and color (/= -1 color))
(setq en000 (append en000 (list (cons 62 color))))
)
(if (= nil (entmake en000))
(princ "\n制造 LWPL 制造失败.")
)
(entlast)
)
