 - ;;;;;;********************************复制或偏移多义线局部线段并连接
- ;;;;;;------------------lxx.2004.7.30
- ;;;;(setq eplst (entsel))
- ;;;;******偏移多义线局部线段并连接
- (defun c:HT_820 (/ ss a b lst dis)
- (defun plnff (eplst / e p1 p ent el el0 k seq plx plx2 p2 pt d)
- (setq e (car eplst)
- p1 (cadr eplst)
- p (vlax-curve-getclosestpointto e p1);;确保取点.
- ent(entget e))
- (if (= "LWPOLYLINE" (cdr(assoc 0 ent))) ;;转为旧式pl格式.
- (progn
- (vl-cmdf "_.convertpoly" "h" e "")
- (setq eL (entlast) el0 el ent (entget el) k T)
- )
- (setq el e el0 e)
- )
- (while (/= "SEQEND" (cdr(assoc 0 (setq seq (entget(setq el (entnext el))))))));;取seqend段.
- (setq ent (subst (cons 70 0) (assoc 70 ent) ent) ;;改为不封闭.
- plx (entget (car(nentselp p1)));;取点中段的实体表.
- plx2 (entget(entnext (cdr(assoc -1 plx)))));;下一个.
- (if (equal seq plx2)(setq plx2 (entget (entnext el0))));;如果是闭合段,下一个取pl线第一段.
- (mapcar 'entmakex(mapcar '(lambda (y) (vl-remove-if '(lambda(x)(member (car x) '(-1 5 -2))) y))(list ent plx plx2 seq)));;生成新的pl段.
- ;(if k (entdel el0));;删除多余实体.
- (setq pt (getpoint p "\n偏移方向及距离<输入数字或点取位置>:")
- d (distance p pt)
- el (entlast))
- (vl-cmdf "_.offset" d (list el p) pt "")
- ;(while (/= 0 (getvar "cmdactive")) (vl-cmdf pause))
- (entdel el)
- (if (equal el (entlast)) nil (list eplst d (entlast)))
- )
- (setvar "peditaccept" 1)
- (setq ss (ssadd))
- (while (setq a (entsel))
- (if (setq b (plnff a))
- (setq lst (cons b lst))
- )
- )
- (mapcar '(lambda (x) (ssadd (last x) ss)) lst)
- (setq dis (apply 'max (mapcar '(lambda (x) (nth 1 x)) lst)))
- (vl-cmdf "_.Pedit" "m" ss "" "J" (* 2 dis) "")
- (princ)
- )
| 
发表于 
显身卡
楼主