zjsru_18_505 发表于 2014-6-1 18:09 static/image/common/back.gif
程序有BUG，实例如下：
(command "_line" '(10 0) '(10 10) '(10 20) '(20 20) '(10 10) "")
程序设计之初没有考虑同一方向上与之接触的线，所以说这样的图形出现了bug。该程序仅是考虑了偏移对象相接触并与偏移对象有角度的直线。其他不在该程序范围。
对楼上几位的要求，综合修改了一下
(defun
COLINEARP (P1 P2 P3)
;;;三点共线
((lambda (A B C)
(or (equal (+ A B) C 1e-8) (equal (+ B C) A 1e-8) (equal (+ C A) B 1e-8))
)
(distance P1 P2)
(distance P2 P3)
(distance P1 P3)
)
)
(defun
SK_HIGHLIGHT (SS FLAG / I EN)
;;;高亮图元或选择集
(if (= (type SS) 'PICKSET)
(progn
(setq I -1)
(repeat (sslength SS)
(setq EN (ssname SS (setq I (1+ I))))
(redraw
EN
(if FLAG
3
4
)
)
)
)
)
(if (= (type SS) 'ENAME)
(redraw
SS
(if FLAG
3
4
)
)
)
)
(defun
SK_ENTMOD (E CODE NEW / EN)
;;;(sk_entmod 图元名 组码 新值 )
(setq EN (entget E))
(entmod (subst (cons CODE NEW) (assoc CODE EN) EN))
)
(defun
C:TOO (/ ANG1 BUZO CPT E E1 EN I IP12 J
LEN MODCODE NEW1 NEW2 NEWP1NEWP2OFFSETDI
OFFSETDI1 PT0 PT1 PT2 PT3 PT4 PT5 SS SS1
)
;;;功能：偏移联动
;;;作者：修改自＝楼主: edata
;;;时间：2014-6-1
(if (getenv "OFFSETDI")
(setq OFFSETDI (atof (getenv "OFFSETDI")))
)
(initget 6)
(if (> OFFSETDI 0)
(progn
(if (setq
OFFSETDI1
(getdist
(strcat "\n指定偏移距离" " <" (rtos OFFSETDI) ">:")
)
)
(setq OFFSETDI OFFSETDI1)
)
)
(progn
(while (not (setq OFFSETDI (getdist "\n指定偏移距离:"))) (initget 6))
)
)
(setenv "OFFSETDI" (rtos OFFSETDI))
(defun *ERROR* (MSG) (setvar "OSMODE" BUZO) (princ))
(while (setq SS (ssget '((0 . "line"))))
(setq
I 0
J 0
)
(setq BUZO (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq LEN (sslength SS))
(repeat LEN
(setq
E (ssname SS I)
EN(entget E)
PT1 (cdr (assoc 10 EN))
PT2 (cdr (assoc 11 EN))
PT0 (polar PT1 (angle PT1 PT2) (/ (distance PT1 PT2) 2))
)
(command "_.zoom" PT1 PT2)
(setq SS1 (ssget "_f" (list PT1 PT2) '((0 . "line"))))
(command "_.zoom" "p")
(SK_HIGHLIGHT SS1 t)
(if (setq PT3 (getpoint PT0 "\n指定要偏移的那一侧上的点 <退出当前>:"))
(progn
(SK_HIGHLIGHT SS1 NIL)
(setq SS1 (ssdel E SS1))
(setq
CPT (inters
PT3
(polar PT3 (+ (angle PT1 PT2) (/ pi 2)) 1.0)
PT1
PT2
NIL
)
ANG1 (angle CPT PT3)
NEW1 (polar PT1 ANG1 OFFSETDI)
NEW2 (polar PT2 ANG1 OFFSETDI)
)
(while (setq E1 (ssname SS1 0))
(setq
EN (entget E1)
PT4 (cdr (assoc 10 EN))
PT5 (cdr (assoc 11 EN))
MODCODE NIL
)
(if (or (equal PT4 PT1 1e-8)
(equal PT5 PT1 1e-8)
(COLINEARP PT1 PT4 PT5)
)
(if (setq NEWP1 (inters NEW1 NEW2 PT4 PT5 NIL))
(setq NEW1 NEWP1)
)
)
(if (or (equal PT4 PT2 1e-8)
(equal PT4 PT2 1e-8)
(COLINEARP PT2 PT4 PT5)
)
(if (setq NEWP2 (inters NEW1 NEW2 PT4 PT5 NIL))
(setq NEW2 NEWP2)
)
)
(if (COLINEARP PT4 PT1 PT2)
(setq MODCODE 10)
)
(if (COLINEARP PT5 PT1 PT2)
(setq MODCODE 11)
)
(if (and (setq IP12 (inters NEW1 NEW2 PT4 PT5 NIL)) MODCODE)
(progn (SK_ENTMOD E1 MODCODE IP12))
)
(setq SS1 (ssdel E1 SS1))
)
(SK_ENTMOD E 10 NEW1)
(SK_ENTMOD E 11 NEW2)
)
(progn (princ "\n未指定方向点!") (SK_HIGHLIGHT SS1 NIL))
)
(setq I (1+ I))
)
(setvar "OSMODE" BUZO)
)
(princ)
)
edata 发表于 2014-5-9 18:09 static/image/common/back.gif
LWPOLYLINE线单边偏移关联(仅多段线)
试了一下，相当给力！但是也发现了个问题，就是当坐标系不是世界坐标的时候出现了混乱情况。建议在前面加一个坐标系还原世界坐标。
很给力顶一下
好程序 经典实用
好程序 经典实用
程序很好用，但不支持UCS，希望改进一下支持UCS，谢谢！！
这个好，工作上用到
E大的精品先收藏了
楼主的思路很好，在他的启发下怎么来让我们用交叉多边形选择少选一半的点，另一半对称过来。
;点边界点来拉伸。
(defun c:test()
(setq plst1'()
plst2'()
plst3'()
)
;选择点。
(while(setq pnt(getpoint))
(setq plst1(cons (polar pnt 00.5) plst1);0.5适合本人的工作图纸。
plst2(cons (polar pnt pi 0.5) plst2)
)
)
;现在两表中有一半的点了。;把两个端点再调整一下。
;1表的两个端点。
(setq pnt1(car plst1)
pnt2(cadr plst1)
an1 (angle pnt2 pnt1)
pnt1(polar pnt1 an1 0.5)
plst1(cdr plst1)
plst1(cons pnt1 plst1)
pnt3(nth (-(length plst1 )1) plst1)
pnt4(nth (-(length plst1 )2) plst1)
an2 (angle pnt4 pnt3)
pnt5(polar pnt3 an2 0.5)
plst1(vl-remove pnt3 plst1)
plst1(append plst1 (list pnt5))
)
;(command "circle" "non"pnt1 1)
;(command "circle" "non"pnt5 1)
;2表的两个端点。
(setq pnt6(car plst2)
pnt7(cadr plst2)
an3 (angle pnt7 pnt6)
pnt66(polar pnt6 an3 0.5)
plst2(cdr plst2)
plst2(cons pnt66 plst2)
pnt8(nth (-(length plst1 )1) plst2)
pnt9(nth (-(length plst1 )2) plst2)
an4 (angle pnt9 pnt8)
pnt88(polar pnt8 an4 0.5)
plst2(vl-remove pnt8 plst2)
plst2(appendplst2 (list pnt88) )
)
;(command "circle" "non"pnt66 1)
;(command "circle" "non"pnt88 1)
;得到闭合点，反向2表。
(setq pt2 (last plst2)
plst2 (reverse plst2)
)
;合并两个表
(setq plst3 (append plst2 plst1 (list pt2)))
;拉伸命令有CP选择的点表了
(command "stretch" (ssget "CP"plst3)"" pause)
)
(defun c:test1( / )
(setq plst1'()
plst2'()
plst3'()
dist (getdist"输入宽度")
pntb (getpoint "选择边界点"))
(if(null dist)(setq dist 0.5))
(while (setq pnta (getpoint pntb"选择边界点"))
(setq ana (+(angle pntb pnta)(/ pi 2))
anb (+ ana pi)
plst1 (cons (polar pntbanadist) plst1)
plst2 (cons (polar pntbanbdist) plst2)
pntb pnta
) )
(setq plst1 (cons (polar pntb anadist) plst1)
plst2 (cons (polar pntb anbdist) plst2)
pnt(last plst)
plst2 (reverse plst2)
plst3 (append plst2 plst1 (list pnt)))
(setq k 0 )
(foreach pnts plst3
(grdraw (nth k plst3) (nth (+ k 1) plst3) 1 0)
(setq k(1+ k)))
;(command "stretch" (ssget "CP"plst3) "R"pause)
)