拉伸曲线保持原图层

newer · 发表于 2016-10-4 21:11:14

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 newer 于 2016-10-4 21:16 编辑

兄弟曾经写的，愿天堂里一切安好！！找出来，让它继续发光。

(defun c:ez (/ ss i n2 n ext_h ent entl entn i la e70) (princ "\n ez=====extrude拉伸实体,保持原图层-----------陌生人.2001.6")
(princ "\n 当前选项 : 对不封闭的实体自动封闭并拉伸;")
(princ " 拉伸高度")
(princ ext_h)
(command ".undo" "be")
(if (setq ss (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE,region"))))
(progn
(setq i 0
n2 0
n (sslength ss)
cl_key T
)
(while (not (setq ext_h (getdist "\n拉伸高度<改变选项: 对不封闭的实体不处理>:")))
(setq cl_key nil)
(princ "\n 当前选项 : 对不封闭的实体不处理")
)
(repeat n
(setq ent (ssname ss i)
entl (entget ent)
entn (cdr (assoc 0 entl))
i (1+ i)
la (cdr (assoc 8 entl))
e70 (cdr (assoc 70 entl))
)
(if (and
(= "LWPOLYLINE" entn)
cl_key
)
(command ".pedit" ent "Close" "")
)
(command "_.extrude" ent "" ext_h "0")
(setq e (entlast))
(command "_.change" e "" "p" "la" la "")
) ; end repeat
(command ".undo" "e")
(princ (strcat "\n选中" (rtos n) "个"))
(princ (strcat "\n" (rtos n2) "个不成功."))
)
)
(princ)
)
(princ "\n ez=====extrude拉伸实体,保持原图层V1.1-----------陌生人.2001.6 2003.12")

(defun c:ez (/ ss i n2 n ext_h ent entl entn i la e70)  (princ "\n ez=====extrude拉伸实体,保持原图层-----------陌生人.2001.6") 
  (princ "\n 当前选项 : 对不封闭的实体自动封闭并拉伸;") 
  (princ "     拉伸高度") 
  (princ ext_h) 
  (command ".undo" "be") 
  (if (setq ss (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE,region")))) 
    (progn 
      (setq i 0 
            n2 0 
            n (sslength ss) 
            cl_key T 
      ) 
      (while (not (setq ext_h (getdist "\n拉伸高度<改变选项: 对不封闭的实体不处理>:"))) 
        (setq cl_key nil) 
        (princ "\n 当前选项 : 对不封闭的实体不处理") 
      ) 
      (repeat n 
        (setq ent (ssname ss i) 
              entl (entget ent) 
              entn (cdr (assoc 0 entl)) 
              i (1+ i) 
              la (cdr (assoc 8 entl)) 
              e70 (cdr (assoc 70 entl)) 
        ) 
        (if (and 
              (= "LWPOLYLINE" entn) 
              cl_key 
            ) 
          (command ".pedit" ent "Close" "") 
        ) 
        (command "_.extrude" ent "" ext_h "0") 
        (setq e (entlast)) 
        (command "_.change" e "" "p" "la" la "") 
      )                                       ; end repeat 
      (command ".undo" "e") 
      (princ (strcat "\n选中" (rtos n) "个")) 
      (princ (strcat "\n" (rtos n2) "个不成功.")) 
    ) 
  ) 
  (princ) 
) 
(princ "\n ez=====extrude拉伸实体,保持原图层V1.1-----------陌生人.2001.6 2003.12")

yoyoho · 发表于 2016-10-5 08:43:08

感谢 N版分享程序,亦感谢原创作人!!!!!

hzj268 · 发表于 2016-10-6 10:31:14

逛一下。。。

clinber · 发表于 2016-10-6 23:40:43

啥也不说了，感谢楼主分享哇！

xinyeyu · 发表于 2019-9-8 23:16:51

很好的插件，支持支持

撒地方的的 · 发表于 2019-9-10 09:58:08

感谢 N版分享程序,亦感谢原创作人!!!!!

whng · 发表于 2019-9-10 12:08:47

感谢 N版分享程序,亦感谢原创作人!!!!!

账号		自动登录	找回密码
密码			立即注册

[曲线] 拉伸曲线保持原图层

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。