无聊源码：多义线局部线段拷贝，偏移程序v1.0-----------lxx.2004.
老程序,呷一口咖啡，追忆往事不堪回首明月中嫦娥;; (plncp eplst)(c:plncp)(plnff eplst)(c:plnff) = 多义线局部线段拷贝，偏移程序v1.0-----------lxx.2004.7.30
(vl-load-com)
(alert "\n 多义线局部线段拷贝，偏移程序v1.0
\n-------梦断江南.2004.7.30--------\n
\n(plncp eplst) = 拷贝多义线单段线段
\nc:plc = 拷贝多义线局部线段并连接
\n(plnff eplst) = 偏移多义线单段线段
\nc:plf = 偏移多义线局部线段并连接
")
;;/////////////////////////////////******拷贝多义线局部线段*****/////////////////////////////////////;;
;| (plncp eplst) = 拷贝多义线单段线段------------ok!!!------------------lxx.2004.7.29
说明: 1.支持polyline及lwpolyline. 2.仅可拷贝单段.
参数: eplst = (entsel)返回的表.必须选中多义线!
返回: (list eplst p2 (distance p p2) el)
测试: (plncp (entsel))
|;
(defun plncp (eplst / e p1 p ent el el0k seq plx plx2 p2)
(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));;删除多余实体.
(vl-cmdf "_.move" (setq el (entlast)) "" p pause)
(if (equal (setq p2 (getvar "lastpoint")) p 1e-4)
(progn (entdel el) nil)
(list eplst p2 (distance p p2) el)
)
)
;;;;;;;;;;;;;;
;| plncp = 拷贝多义线局部线段并连接. -ok!!!------------------lxx.2004.7.30
|;
(defun c:plc (/ ss a b lst dis)
(setq ss (ssadd))
(while (setq a (entsel))
(if (setq b (plncp a))(setq lst (cons b lst)))
)
(mapcar '(lambda(x)(ssadd (last x) ss)) lst)
(setq dis (apply 'max (mapcar '(lambda(x)(nth 2 x)) lst)))
(vl-cmdf "_.Pedit" "m" ss "" "J" (* 2 dis) "")
)
;;/////////////////////////////////******以下是偏移多义线局部线段*****/////////////////////////////////////;;
;| (plnff eplst) = 偏移多义线单段线段------------ok!!!------------------lxx.2004.7.29
说明: 1.支持polyline及lwpolyline. 2.仅可偏移单段.
参数: eplst = (entsel)返回的表.必须选中多义线!
返回: (list eplst p2 (distance p p2) el)
测试: (plnff (entsel))
|;
(defun plnff (eplst / e p1 p ent el el0k 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偏移方向及距离<输入数字or点取>:")
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)))
)
;(setq eplst (entsel))
;;;;;;;;;;;;;;
;| plnff = 偏移多义线局部线段并连接. -ok!!!------------------lxx.2004.7.30
|;
(defun c:plf (/ ss a b lst dis)
(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) "")
)
回复 狂刀lxx 的帖子
谢谢 狂刀 大侠 一挥手 劈出了这么多把 锋利的刀，刀刀不平常
多年来一直在您的代码中学到许多睿智的编程思路。
追忆往事不堪回首明月中嫦娥.. 嘿嘿 好奇中
支持，收藏程序。这么晚了少喝咖啡， 收藏了
下来看看学习学习,慢慢领会
谢谢楼主的分享 收藏慢慢看!!
謝謝 無私的分享 狂刀哥大源码大奉送，多谢了，努力学习lisp 支持，收藏程序。 不错的程序，支持源码共享 支持源码共享
页:
[1]
2