马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
- ;;转向LWPOLYLINE
- (defun rlw ( LW / E X1 X2 X3 X4 X5 X6 )
- ;; by ElpanovEvgeniy
- ;; reverse lwpolyline
- (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
- (progn (foreach a1 e
- (cond ((= (car a1) 10) (setq x2 (cons a1 x2)))
- ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
- ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
- ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
- ((= (car a1) 210) (setq x6 (cons a1 x6)))
- (t (setq x1 (cons a1 x1)))
- )
- )
- (entmod (append (reverse x1)
- (append (apply (function append)
- (apply (function mapcar)
- (cons 'list
- (list x2
- (cdr (reverse (cons (car x3) (reverse x3))))
- (cdr (reverse (cons (car x4) (reverse x4))))
- (cdr (reverse (cons (car x5) (reverse x5))))
- )
- )
- )
- )
- x6
- )
- )
- )
- (entupd lw)
- )
- )
- )
- ;; 转向SPLINE - Marko Ribar, d.i.a.
- (defun rspl ( spl / enx x12 x13 x1 x2 x3 x4 x5 )
- (if (= (cdr (assoc 0 (setq enx (entget spl)))) "SPLINE")
- (progn
- (foreach a1 enx
- (cond
- ( (= (car a1) 12) (setq x13 (cons (cons 13 (mapcar '- (cdr a1))) x13)) )
- ( (= (car a1) 13) (setq x12 (cons (cons 12 (mapcar '- (cdr a1))) x12)) )
- ( (= (car a1) 40) (setq x2 (cons a1 x2)) )
- ( (= (car a1) 10) (setq x3 (cons a1 x3)) )
- ( (= (car a1) 41) (setq x4 (cons a1 x4)) )
- ( (= (car a1) 11) (setq x5 (cons a1 x5)) )
- ( t (setq x1 (cons a1 x1)) )
- )
- )
- (entmod
- (append
- (reverse x1)
- x12
- x13
- (mapcar '(lambda ( x ) (cons 40 (- (cdar x2) (cdr x)))) x2)
- (if x4
- (apply 'append (mapcar '(lambda ( a b ) (list a b)) x3 x4))
- x3
- )
- x5
- )
- )
- (entupd spl)
- )
- )
- )
- ;; 转向HELIX - Marko Ribar, d.i.a.
- (defun rhel ( hel / enx enx1 enx2 v x1 x2 x3 )
- (if (= (cdr (assoc 0 (setq enx (entget hel)))) "HELIX")
- (progn
- (setq enx1 (reverse (cdr (member '(100 . "AcDbHelix") (reverse enx)))))
- (setq enx2 (member '(100 . "AcDbHelix") enx))
- (foreach a1 enx1
- (cond
- ( (= (car a1) 40) (setq x2 (cons a1 x2)) )
- ( (= (car a1) 10) (setq x3 (cons a1 x3)) )
- ( t (setq x1 (cons a1 x1)) )
- )
- )
- (setq enx2 (subst (cons 40 (distance (cdr (assoc 10 enx2)) (cdr (assoc 11 enx2)))) (assoc 40 enx2) enx2))
- (setq enx2 (subst (cons 10 (mapcar '+ (cdr (assoc 10 enx2)) (mapcar '* (cdr (assoc 12 enx2)) (list (* (cdr (assoc 41 enx2)) (cdr (assoc 42 enx2))) (* (cdr (assoc 41 enx2)) (cdr (assoc 42 enx2))) (* (cdr (assoc 41 enx2)) (cdr (assoc 42 enx2))))))) (assoc 10 enx2) enx2))
- (setq enx2 (subst (cons 11 (cdr (car x3))) (assoc 11 enx2) enx2))
- (setq enx2 (subst (cons 12 (mapcar '- (cdr (assoc 12 enx2)))) (assoc 12 enx2) enx2))
- (entmod
- (append
- (reverse x1)
- (mapcar '(lambda ( x ) (cons 40 (- (cdar x2) (cdr x)))) x2)
- x3
- enx2
- )
- )
- (entupd hel)
- )
- )
- )
- ;; 转向LINE - Marko Ribar, d.i.a.
- (defun rli ( li / enx sp ep )
- (if (= (cdr (assoc 0 (setq enx (entget li)))) "LINE")
- (progn
- (setq sp (cdr (assoc 10 enx)) ep (cdr (assoc 11 enx)))
- (setq enx (subst (cons 10 ep) (assoc 10 enx) enx))
- (setq enx (subst (cons 11 sp) (assoc 11 enx) enx))
- (entmod enx)
- (entupd li)
- )
- )
- )
- ;; 转向3DPOLYLINE - Marko Ribar, d.i.a.
- (defun r3dp ( 3dp / v p pl sfa var )
- (vl-load-com)
- (if
- (and
- (= (cdr (assoc 0 (entget 3dp))) "POLYLINE")
- (< 7 (cdr (assoc 70 (entget 3dp))) 10)
- )
- (progn
- (setq v 3dp)
- (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX")
- (setq p (cdr (assoc 10 (entget v))))
- (setq pl (cons p pl))
- )
- (setq pl (apply 'append pl))
- (setq sfa (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pl)))))
- (vlax-safearray-fill sfa pl)
- (setq var (vlax-make-variant sfa))
- (vla-put-coordinates (vlax-ename->vla-object 3dp) var)
- (entupd 3dp)
- )
- )
- )
- ;; 转向old heavy 2d POLYLINE - Marko Ribar, d.i.a.
- (defun rhpl ( hpl / rlw )
- (vl-load-com)
- (defun rlw ( LW / E X1 X2 X3 X4 X5 X6 )
- ;; by ElpanovEvgeniy
- ;; reverse lwpolyline
- (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
- (progn (foreach a1 e
- (cond ((= (car a1) 10) (setq x2 (cons a1 x2)))
- ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
- ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
- ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
- ((= (car a1) 210) (setq x6 (cons a1 x6)))
- (t (setq x1 (cons a1 x1)))
- )
- )
- (entmod (append (reverse x1)
- (append (apply (function append)
- (apply (function mapcar)
- (cons 'list
- (list x2
- (cdr (reverse (cons (car x3) (reverse x3))))
- (cdr (reverse (cons (car x4) (reverse x4))))
- (cdr (reverse (cons (car x5) (reverse x5))))
- )
- )
- )
- )
- x6
- )
- )
- )
- (entupd lw)
- )
- )
- )
- (if
- (and
- (= (cdr (assoc 0 (entget hpl))) "POLYLINE")
- (or
- (< -1 (cdr (assoc 70 (entget hpl))) 6)
- (< 127 (cdr (assoc 70 (entget hpl))) 134)
- )
- )
- (progn
- (cond
- ( (or (< -1 (cdr (assoc 70 (entget hpl))) 2) (< 127 (cdr (assoc 70 (entget hpl))) 130))
- (command "_.CONVERTPOLY" "_L" hpl "")
- (rlw hpl)
- (command "_.CONVERTPOLY" "_H" hpl "")
- (entupd hpl)
- )
- ( (or (< 1 (cdr (assoc 70 (entget hpl))) 4) (< 129 (cdr (assoc 70 (entget hpl))) 132))
- (vla-put-type (vlax-ename->vla-object hpl) (- (vla-get-type (vlax-ename->vla-object hpl)) 1))
- (command "_.CONVERTPOLY" "_L" hpl "")
- (rlw hpl)
- (command "_.CONVERTPOLY" "_H" hpl "")
- (vla-put-type (vlax-ename->vla-object hpl) (+ (vla-get-type (vlax-ename->vla-object hpl)) 1))
- (entupd hpl)
- )
- ( (and (or (< 3 (cdr (assoc 70 (entget hpl))) 6) (< 131 (cdr (assoc 70 (entget hpl))) 134)) (= (cdr (assoc 75 (entget hpl))) 5))
- (vla-put-type (vlax-ename->vla-object hpl) (- (vla-get-type (vlax-ename->vla-object hpl)) 2))
- (command "_.CONVERTPOLY" "_L" hpl "")
- (rlw hpl)
- (command "_.CONVERTPOLY" "_H" hpl "")
- (vla-put-type (vlax-ename->vla-object hpl) (+ (vla-get-type (vlax-ename->vla-object hpl)) 2))
- (entupd hpl)
- )
- ( (and (or (< 3 (cdr (assoc 70 (entget hpl))) 6) (< 131 (cdr (assoc 70 (entget hpl))) 134)) (= (cdr (assoc 75 (entget hpl))) 6))
- (vla-put-type (vlax-ename->vla-object hpl) (- (vla-get-type (vlax-ename->vla-object hpl)) 3))
- (command "_.CONVERTPOLY" "_L" hpl "")
- (rlw hpl)
- (command "_.CONVERTPOLY" "_H" hpl "")
- (vla-put-type (vlax-ename->vla-object hpl) (+ (vla-get-type (vlax-ename->vla-object hpl)) 3))
- (entupd hpl)
- )
- )
- )
- )
- )
- ;; 转向3DPOLYLINE - Marko Ribar, d.i.a.
- (defun r3dp ( 3dp / r3dppol typ )
- (defun r3dppol ( 3dp / v p pl sfa var )
- (vl-load-com)
- (setq v 3dp)
- (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX")
- (setq p (cdr (assoc 10 (entget v))))
- (setq pl (cons p pl))
- )
- (setq pl (apply 'append pl))
- (setq sfa (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pl)))))
- (vlax-safearray-fill sfa pl)
- (setq var (vlax-make-variant sfa))
- (vla-put-coordinates (vlax-ename->vla-object 3dp) var)
- (entupd 3dp)
- )
- (setq typ (vla-get-type (vlax-ename->vla-object 3dp)))
- (vla-put-type (vlax-ename->vla-object 3dp) acsimplepoly)
- (r3dppol 3dp)
- (if typ (vla-put-type (vlax-ename->vla-object 3dp) typ))
- (entupd 3dp)
- )
- ;转向2D POLYLINE和LWPOLYLINE
- ; (KGA_List_Divide_2 '(0 1 2 3 4 5 6 7 8 9)) => ((0 1) (2 3) (4 5) (6 7) (8 9))
- ; (KGA_List_Divide_2 '(0 1 2 3 4 5 6 7 8)) => ((0 1) (2 3) (4 5) (6 7))
- (defun KGA_List_Divide_2 (lst / ret)
- (repeat (/ (length lst) 2)
- (setq ret (cons (list (car lst) (cadr lst)) ret))
- (setq lst (cddr lst))
- )
- (reverse ret)
- )
-
- ; (KGA_List_Divide_3 '(0 1 2 3 4 5 6 7 8)) => ((0 1 2) (3 4 5) (6 7 8))
- ; (KGA_List_Divide_3 '(0 1 2 3 4 5 6 7)) => ((0 1 2) (3 4 5))
- (defun KGA_List_Divide_3 (lst / ret)
- (repeat (/ (length lst) 3)
- (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
- (setq lst (cdddr lst))
- )
- (reverse ret)
- )
-
- ; Make a zero based list of integers.
- ; With speed improvement based on Reini Urban's (std-%setnth).
- ; (KGA_List_IndexSeqMakeLength 7) => (0 1 2 3 4 5 6)
- (defun KGA_List_IndexSeqMakeLength (len / ret)
- (repeat (rem len 4)
- (setq ret (cons (setq len (1- len)) ret))
- )
- (repeat (/ len 4)
- (setq ret
- (vl-list*
- (- len 4)
- (- len 3)
- (- len 2)
- (- len 1)
- ret
- )
- )
- (setq len (- len 4))
- )
- ret
- )
-
- ; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline".
- ; (KGA_Geom_PolylineReverse (vlax-ename->vla-object (car (entsel))))
- (defun KGA_Geom_PolylineReverse (obj / bulgeLst idxLst ptLst widLst)
- (setq ptLst
- ((if (= "AcDb2dPolyline" (vla-get-objectname obj)) KGA_List_Divide_3 KGA_List_Divide_2)
- (vlax-get obj 'coordinates)
- )
- )
- (setq idxLst (KGA_List_IndexSeqMakeLength (length ptLst)))
- (setq bulgeLst
- (mapcar
- '(lambda (idx) (vla-getbulge obj idx))
- idxLst
- )
- )
- (setq widLst
- (mapcar
- '(lambda (idx / widSta widEnd)
- (vla-getwidth obj idx 'widSta 'widEnd)
- (list widSta widEnd)
- )
- idxLst
- )
- )
- (mapcar
- '(lambda (idx pt bulge widSub)
- (vlax-put obj 'coordinate idx pt)
- (vla-setbulge obj idx (- bulge))
- (vla-setwidth obj idx (cadr widSub) (car widSub))
- )
- idxLst
- (reverse ptLst)
- (append (cdr (reverse bulgeLst)) (list (car bulgeLst)))
- (append (cdr (reverse widLst)) (list (car widLst)))
- )
- )
- ;; 转向 heavy 2d POLYLINE - Marko Ribar, d.i.a.
- (defun rhpl ( hpl / KGA_List_Divide_3 KGA_List_IndexSeqMakeLength KGA_Geom_PolylineReverse )
-
- (vl-load-com)
-
- ; (KGA_List_Divide_3 '(0 1 2 3 4 5 6 7 8)) => ((0 1 2) (3 4 5) (6 7 8))
- ; (KGA_List_Divide_3 '(0 1 2 3 4 5 6 7)) => ((0 1 2) (3 4 5))
- (defun KGA_List_Divide_3 (lst / ret)
- (repeat (/ (length lst) 3)
- (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
- (setq lst (cdddr lst))
- )
- (reverse ret)
- )
-
- ; Make a zero based list of integers.
- ; With speed improvement based on Reini Urban's (std-%setnth).
- ; (KGA_List_IndexSeqMakeLength 7) => (0 1 2 3 4 5 6)
- (defun KGA_List_IndexSeqMakeLength (len / ret)
- (repeat (rem len 4)
- (setq ret (cons (setq len (1- len)) ret))
- )
- (repeat (/ len 4)
- (setq ret
- (vl-list*
- (- len 4)
- (- len 3)
- (- len 2)
- (- len 1)
- ret
- )
- )
- (setq len (- len 4))
- )
- ret
- )
-
- ; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline".
- ; (KGA_Geom_PolylineReverse (vlax-ename->vla-object (car (entsel))))
- (defun KGA_Geom_PolylineReverse (obj / typ bulgeLst idxLst ptLst widLst conWid v vx)
- (setq typ (vla-get-type obj))
- (vla-put-type obj acsimplepoly)
- (setq ptLst (KGA_List_Divide_3 (vlax-get obj 'coordinates)))
- (setq idxLst (KGA_List_IndexSeqMakeLength (1+ (length ptLst))))
- (setq v (vlax-vla-object->ename obj))
- (while (= (cdr (assoc 0 (setq vx (entget (setq v (entnext v)))))) "VERTEX")
- (setq widLst (cons (list (cdr (assoc 40 vx)) (cdr (assoc 41 vx))) widLst))
- (setq bulgeLst (cons (cdr (assoc 42 vx)) bulgeLst))
- )
- (if (vl-catch-all-error-p (setq conWid (vl-catch-all-apply 'vla-get-constantwidth (list obj))))
- (mapcar
- '(lambda (idx pt bulge widSub)
- (vla-put-coordinate obj idx (vlax-3d-point pt))
- (vla-setbulge obj idx (- bulge))
- (vla-setwidth obj idx (cadr widSub) (car widSub))
- )
- idxLst
- (reverse ptLst)
- (append (cdr bulgeLst) (list (car bulgeLst)))
- (append (cdr widLst) (list (car widLst)))
- )
- (progn
- (mapcar
- '(lambda (idx pt bulge widSub)
- (vla-put-coordinate obj idx (vlax-3d-point pt))
- (vla-setbulge obj idx (- bulge))
- )
- idxLst
- (reverse ptLst)
- (append (cdr bulgeLst) (list (car bulgeLst)))
- )
- (vla-put-constantwidth obj conWid)
- )
- )
- (if typ (vla-put-type obj typ))
- )
-
- (KGA_Geom_PolylineReverse (vlax-ename->vla-object hpl))
- (entupd hpl)
- )
另外一个版本转向"AcDb2dPolyline" or an "AcDbPolyline"
|