oo 偏移多段线中的指定线段

forestgxc

oo 偏移多段线中的指定线段

forestgxc

lxl304712346 发表于 2025-11-3 15:39
加载后提示     Error: 非法的 FAS 文件格式 FAS5-FILE!

lispsys=1
重开acad

ㄘ丶转裑ㄧ灬

1. ;;;;;;********************************复制或偏移多义线局部线段并连接
   
2. ;;;;;;------------------lxx.2004.7.30
   
3. ;;;;(setq eplst (entsel))
   
4. ;;;;******偏移多义线局部线段并连接
   
5. (defun c:HT_820 (/ ss a b lst dis)
   
6. (defun plnff (eplst / e p1 p ent el el0  k seq plx plx2 p2 pt d)
   
7.   (setq e  (car eplst)
   
8. p1 (cadr eplst)
   
9. p  (vlax-curve-getclosestpointto e p1);;确保取点.
   
10.         ent(entget e))
    
11.   (if (= "LWPOLYLINE" (cdr(assoc 0 ent))) ;;转为旧式pl格式.
    
12.     (progn
    
13.       (vl-cmdf "_.convertpoly" "h" e "")
    
14.       (setq eL (entlast) el0 el ent (entget el) k T)
    
15.     )
    
16.     (setq el e el0 e)
    
17.   )
    
18.   (while (/= "SEQEND" (cdr(assoc 0 (setq seq (entget(setq el (entnext el))))))));;取seqend段.
    
19.   (setq ent (subst (cons 70 0) (assoc 70 ent) ent) ;;改为不封闭.
    
20.         plx (entget (car(nentselp p1)));;取点中段的实体表.
    
21.        plx2 (entget(entnext (cdr(assoc -1 plx)))));;下一个.
    
22.   (if (equal seq plx2)(setq plx2 (entget (entnext el0))));;如果是闭合段,下一个取pl线第一段.
    
23.   (mapcar 'entmakex(mapcar '(lambda (y) (vl-remove-if '(lambda(x)(member (car x) '(-1 5 -2))) y))(list ent plx plx2 seq)));;生成新的pl段.
    
24.   ;(if k (entdel el0));;删除多余实体.
    
25. (setq  pt (getpoint p "\n偏移方向及距离<输入数字或点取位置>:")
    
26. d  (distance p pt)
    
27. el (entlast))
    
28.   (vl-cmdf "_.offset" d (list el p) pt "")
    
29.   ;(while (/= 0 (getvar "cmdactive")) (vl-cmdf pause))
    
30.   (entdel el)
    
31.   (if (equal el (entlast)) nil (list eplst d (entlast)))
    
32. )
    
33. (setvar "peditaccept" 1)
    
34.   (setq ss (ssadd))
    
35.   (while (setq a (entsel))
    
36.     (if  (setq b (plnff a))
    
37.       (setq lst (cons b lst))
    
38.     )
    
39.   )
    
40.   (mapcar '(lambda (x) (ssadd (last x) ss)) lst)
    
41.   (setq dis (apply 'max (mapcar '(lambda (x) (nth 1 x)) lst)))
    
42.   (vl-cmdf "_.Pedit" "m" ss "" "J" (* 2 dis) "")
    
43.   (princ)
    
44. )
    

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

forestgxc

ㄘ丶转裑ㄧ灬 发表于 2025-11-4 09:34

功底比我这强多了，
我需要的功能仅限于偏移于一条线，偏移线新建个图层，另外一种线型,仅此而已，后面可以考虑可以直接偏移直线
您这个交互上穴位复杂了，类似于Offset就好了，o 距离 偏移就好
再增加个记忆功能就好了

Txxxx6

非常厉害 这样就可以偏移矩形了的一个边了 不用打散了

qifeifei

很实用啊 在也不用去打散后在偏移了 如果是源码就好了 可以自定义指令

forestgxc

qifeifei 发表于 2025-11-3 14:51
很实用啊 在也不用去打散后在偏移了 如果是源码就好了 可以自定义指令

发源码，挨喷，不发了

qifeifei

forestgxc 发表于 2025-11-3 15:05
发源码，挨喷，不发了

到底是谁喷你 ；那源码都没有了 就不快乐啊；是谁导致了我没有源码可以用！！！到底谁啊

lxl304712346

加载后提示     Error: 非法的 FAS 文件格式 FAS5-FILE!

张向华

很实用啊 在也不用去打散后在偏移了

lxl304712346

forestgxc 发表于 2025-11-3 16:11
lispsys=1
重开acad

acad可以了。但是在中望cad还是不行