[求助]求从多段线偏移某个线条的lisp程序？

TANER

IS-ENAME在三楼

hhh454

双向偏移，好东东呀，

xyp1964

2. ;; 多段线逐段双向偏移
3. (defun c:test823 ()
4.   (CMDLA0)
5.   (xyp-MkLaCo "TEST" 1)
6.   (SETQ DIST (UDIST 1 "" "距离<输入或鼠标直接量取>" DIST nil))
7.   (while (setq e (entsel "\n多段线: "))   
8.     (if (member (xyp-get-dxf 0 (car e)) '("POLYLINE" "LWPOLYLINE"))
9.       (progn
10. (setq a  (xyp-get-Pts&Pte e)
11.        p1 (car a)
12.        p2 (cadr a)
13.        S2 (XYP-ADD-LINE P1 P2)
14. )
15. (xyp-Offset (entlast) dist t t t)
16.       )
17.     )
18.   )
19.   (CMDLA1)
20. )

;; 多段线逐段双向偏移 (defun c:test823 ()   (CMDLA0)   (xyp-MkLaCo "TEST" 1)   (SETQ DIST (UDIST 1 "" "距离<输入或鼠标直接量取>" DIST nil))   (while (setq e (entsel "\n多段线: "))        (if (member (xyp-get-dxf 0 (car e)) '("POLYLINE" "LWPOLYLINE"))       (progn (setq a  (xyp-get-Pts&Pte e)        p1 (car a)        p2 (cadr a)        S2 (XYP-ADD-LINE P1 P2) ) (xyp-Offset (entlast) dist t t t)       )     )   )   (CMDLA1) )

zfsaaa

cj52000发表于2009-9-11 22:12:00刚才我在2004下又试了一遍，还是提示上面的错误啊，请楼上的兄弟再看看啊

我试过不行

zfsaaa

错误: no function definition: VLAX-ENAME-&gt;VLA-OBJECT

狂刀lxx

大家别笑，04年那时候还没空玩vl，vba
程序中command可以用相应另外写的函数替换

3. ;| (plnff eplst) = 偏移多义线单段线段------------ok!!!------------------lxx.2004.7.29
4. 说明: 1.支持polyline及lwpolyline. 2.仅可偏移单段.
5. 参数: eplst = (entsel)返回的表.必须选中多义线!
6. 返回: (list eplst p2 (distance p p2) el)
7. 测试: (plnff (entsel))
8. |;
9. (defun plnff (eplst / e p1 p ent el el0  k seq plx plx2 p2 pt d)
10.   (setq e  (car eplst)
11. p1 (cadr eplst)
12. p  (vlax-curve-getclosestpointto e p1);;确保取点.
13.         ent(entget e))
14.   (if (= "LWPOLYLINE" (cdr(assoc 0 ent))) ;;转为旧式pl格式.
15.     (progn
16.       (vl-cmdf "_.convertpoly" "h" e "")
17.       (setq eL (entlast) el0 el ent (entget el) k T)
18.     )
19.     (setq el e el0 e)
20.   )
21.   (while (/= "SEQEND" (cdr(assoc 0 (setq seq (entget(setq el (entnext el))))))));;取seqend段.
22.   (setq ent (subst (cons 70 0) (assoc 70 ent) ent) ;;改为不封闭.
23.         plx (entget (car(nentselp p1)));;取点中段的实体表.
24.        plx2 (entget(entnext (cdr(assoc -1 plx)))));;下一个.
25.   (if (equal seq plx2)(setq plx2 (entget (entnext el0))));;如果是闭合段,下一个取pl线第一段.
26.   (mapcar 'entmakex(mapcar '(lambda (y) (vl-remove-if '(lambda(x)(member (car x) '(-1 5 -2))) y))(list ent plx plx2 seq)));;生成新的pl段.
27.   ;(if k (entdel el0));;删除多余实体.
28.   (setq pt (getpoint p "\n偏移方向及距离<输入数字or点取>:")
29. d  (distance p pt)
30. el (entlast))
31.   (vl-cmdf "_.offset" d (list el p) pt "")
32.   ;(while (/= 0 (getvar "cmdactive")) (vl-cmdf pause))
33.   (entdel el)
34.   (if (equal el (entlast)) nil (list eplst d (entlast)))
35. )

;| (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 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偏移方向及距离<输入数字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))) )

TANER

2. ;;; 偏移多义线的某一段
3. (defun c:t115 (/ bul dis dt-pt ent laste pt)
4.   (p-s '("CMDECHO"
5.   0
6.   "OSMODE"
7.   0
8. )
9.        t
10.   )
11.   (setq ent (usel4 0 "*polyline" "点取将要偏移的多义线的某一段"))
12.   (setq dis (vlax-ldata-get "mydict" "dis"))
13.   (setq dis (udist 3 "" "请输入偏移距离" dis nil))
14.   (vlax-ldata-put "mydict" "dis" dis)
15.   (setq dt-pt (upoint 7 "" "請拾點以决定偏移方向" dt-pt nil))
16.   (setq pt  (cadr ent)
17. ent (car ent)
18.   )
19.   (setq bul (th-pl-getsegat (th2o ent) (osnap pt "_nea")))
20.   (cond
21.     ((= (car bul) "kLine")
22.      (setq laste (txt-mkline (txt-3rd bul) (txt-4th bul)))
23.      (vl-cmdf "_.OFFSET" dis laste dt-pt "")
24.      (entdel laste)
25.     )
26.     ((= (car bul) "kArc")
27.      (vl-cmdf "_.ARC"
28.        "C"
29.        (txt-3rd bul)
30.        (txt-4th bul)
31.        (txt-5th bul)
32.      )
33.      (setq laste (entlast))
34.      (vl-cmdf "_.OFFSET" dis laste dt-pt "")
35.      (entdel laste)
36.     )
37.   )
38.   (p-e)
39. )
40. (defun c:t116 (/ dis dt-pt ent pt seg)
41.   (p-s '("cmdecho"
42.   0
43.   "osmode"
44.   0
45. )
46.        t
47.   )
48.   (setq ent (usel4 0 "*polyline" "点取将要偏移的多义线的某一段"))
49.   (setq dis (vlax-ldata-get "mydict" "dis"))
50.   (setq dis (udist 3 "" "请输入偏移距离" dis nil))
51.   (vlax-ldata-put "mydict" "dis" dis)
52.   (setq dt-pt (upoint 3 "" "請拾取點以决定偏移方向" dt-pt nil))
53.   (setq pt  (cadr ent)
54. ent (car ent)
55.   )
56.   (setq seg (th-copy-polyseg ent pt))
57.   (vl-cmdf "_.offset" dis (th2e seg) dt-pt "")
58.   (vla-delete seg)
59.   (p-e)
60. );自定义函数加载网盘里的T2.VLX

;;; 偏移多义线的某一段 (defun c:t115 (/ bul dis dt-pt ent laste pt)   (p-s '("CMDECHO"   0   "OSMODE"   0 )        t   )   (setq ent (usel4 0 "*polyline" "点取将要偏移的多义线的某一段"))   (setq dis (vlax-ldata-get "mydict" "dis"))   (setq dis (udist 3 "" "请输入偏移距离" dis nil))   (vlax-ldata-put "mydict" "dis" dis)   (setq dt-pt (upoint 7 "" "請拾點以决定偏移方向" dt-pt nil))   (setq pt  (cadr ent) ent (car ent)   )   (setq bul (th-pl-getsegat (th2o ent) (osnap pt "_nea")))   (cond     ((= (car bul) "kLine")      (setq laste (txt-mkline (txt-3rd bul) (txt-4th bul)))      (vl-cmdf "_.OFFSET" dis laste dt-pt "")      (entdel laste)     )     ((= (car bul) "kArc")      (vl-cmdf "_.ARC"        "C"        (txt-3rd bul)        (txt-4th bul)        (txt-5th bul)      )      (setq laste (entlast))      (vl-cmdf "_.OFFSET" dis laste dt-pt "")      (entdel laste)     )   )   (p-e) ) (defun c:t116 (/ dis dt-pt ent pt seg)   (p-s '("cmdecho"   0   "osmode"   0 )        t   )   (setq ent (usel4 0 "*polyline" "点取将要偏移的多义线的某一段"))   (setq dis (vlax-ldata-get "mydict" "dis"))   (setq dis (udist 3 "" "请输入偏移距离" dis nil))   (vlax-ldata-put "mydict" "dis" dis)   (setq dt-pt (upoint 3 "" "請拾取點以决定偏移方向" dt-pt nil))   (setq pt  (cadr ent) ent (car ent)   )   (setq seg (th-copy-polyseg ent pt))   (vl-cmdf "_.offset" dis (th2e seg) dt-pt "")   (vla-delete seg)   (p-e) );自定义函数加载网盘里的T2.VLX

cj52000

TANER兄的程序还是提示错误

t115 ; 错误: no function definition: P-S

烦请看看