找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 637|回复: 1

[转贴]:SelectByPolyline

[复制链接]

已领礼包: 593个

财富等级: 财运亨通

发表于 2003-11-28 00:28:24 | 显示全部楼层 |阅读模式

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

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

×

  1. (defun SelectByPolyline        (/ ent_pl entl_pl pnt ss_pnts item)
  2.   (setq ent_pl (car (entsel "\nSelect a polyline")))
  3.   (setq entl_pl (entget ent_pl))
  4.   (setq ss_pnts nil)
  5.   (princ "\nSelected is    ")
  6.   (foreach item        entl_pl
  7.     (if        (= (car item) 10)
  8.       (setq pnt            (cdr item)
  9.             ss_pnts (append ss_pnts
  10.                             (list (list (car pnt) (nth 1 pnt) 0.0))
  11.                     )
  12.       )
  13.     )
  14.   )
  15.   (setq ss_ents (ssget "wp" ss_pnts))
  16. )

Test

  1. (defun c:testit (/ ss item entl c1)
  2.     (setq ss (SelectByPolyline))
  3.     (setq c1 (cons 8 "0"))
  4.     (setq i 0)
  5.     (repeat (sslength ss)
  6.         (setq item (ssname ss i))
  7.         (setq entl (entget item))
  8.         (setq i (1+ i))
  9.         (setq entl (subst c1 (assoc 8 entl) entl))
  10.         (entmod entl)
  11.     )
  12.     (princ)
  13. )

其他几个函数

  1. ;;; ------------------------------------------------------------------------
  2. ;;; Creates a new polyline based on the existing properties
  3. ;;; of the source vla-pline-object
  4. ;;;
  5. ;;; Note: this function does not check for Xdata or other data
  6. ;;; that might be attached to the original entity.
  7. ;;;
  8. ;;; Neither does it check for an association of the original
  9. ;;; object to an object reactor.
  10. ;;;
  11. ;;; Returns a newly created polyline using the
  12. ;;; properties of the source vla-pline-object.
  13. ;;;
  14. (defun Create-New-Poly-Type
  15.        (vla-pline-object polytype / splined-pline-object)
  16.   ;; get the coordinates of the pline
  17.   (setq        splined-pline-object
  18.          (vla-AddPolyline
  19.            (vla-get-ModelSpace
  20.              (vla-get-ActiveDocument
  21.                (vlax-get-acad-object)
  22.              )
  23.            )
  24.            (vla-get-coordinates vla-pline-object)
  25.          )
  26.   )
  27.   (vla-put-type splined-pline-object PolyType)
  28.   ;; Transfer some of the properties of the source polyline object
  29.   ;; to the newly created one.
  30.   (foreach Property '("Closed"                 "Color"
  31.                       "ConstantWidth"         "Linetype"
  32.                       "LinetypeGeneration"
  33.                       "LinetypeScale"         "Lineweight"
  34.                       "Normal"                 "PlotStyleName"
  35.                       "Thickness"         "Visible"
  36.                       "Elevation"
  37.                      )
  38.     (vlax-put splined-pline-object
  39.               Property
  40.               (vlax-get vla-pline-object Property)
  41.     )
  42.   )
  43.   ;; Erase the source polyline object
  44.   (vla-erase vla-pline-object)
  45.   ;; Return the new polyline object
  46.   splined-pline-object
  47. ) ;_ end of Create-New-Poly-Type
  48. ;;; ------------------------------------------------------------------------
  49. --
  50. ;; takes a 3dpoly and curves it like Pedit
  51. ;;; (vla-Pline->Pline-Fit-Curve (vlax-ename->vla-object (car (entsel))))
  52. ;;; Returns either the modified polyline or a newly created
  53. ;;; polyline if it is required.
  54. (defun vla-Pline->Pline-Fit-Curve (vla-pline-object)
  55.   (if (member (vla-get-ObjectName vla-pline-object)
  56.               '("AcDb3dPolyline" "AcDb2dPolyline" "AcDbPolyline")
  57.       )
  58.     (cond ((member (vla-get-ObjectName vla-pline-object)
  59.                    '("AcDb2dPolyline")
  60.            )
  61.            (vla-put-type vla-pline-object acFitCurvePoly)
  62.            vla-pline-object
  63.           )

  64.           ((member (vla-get-ObjectName vla-pline-object)
  65.                    '("AcDb3dPolyline")
  66.            )
  67.            (princ "Can not Fit Curve a 3D Polyline")
  68.            vla-pline-object
  69.           )

  70.           (T
  71.            (Create-New-Poly-Type vla-pline-object acFitCurvePoly)
  72.           )
  73.     )
  74.   )
  75. ) ;_ end of vla-Pline->Pline-Fit-Curve
  76. ;;; ------------------------------------------------------------------------
  77. --
  78. (defun c:FitCurve ()
  79.   (vla-Pline->Pline-Fit-Curve
  80.     (vlax-ename->vla-object (car (entsel)))
  81.   )
  82.   (princ)
  83. )
  84. ;;; ------------------------------------------------------------------------
  85. --
  86. ;; decurves a pline
  87. ;;; (vla-Pline->Pline-Decurve (vlax-ename->vla-object (car (entsel))))
  88. ;;; Returns either the modified polyline or a newly created
  89. ;;; polyline if it is required.
  90. (defun vla-Pline->Pline-Decurve        (vla-pline-object)
  91.   (if (member (vla-get-ObjectName vla-pline-object)
  92.               '("AcDb3dPolyline" "AcDb2dPolyline" "AcDbPolyline")
  93.       )
  94.     (cond ((member (vla-get-ObjectName vla-pline-object)
  95.                    '("AcDb2dPolyline")
  96.            )
  97.            (vla-put-type vla-pline-object acSimplePoly)
  98.            vla-pline-object
  99.           )

  100.           ((member (vla-get-ObjectName vla-pline-object)
  101.                    '("AcDb3dPolyline")
  102.            )
  103.            (princ "Can not Decurve a 3D Polyline")
  104.            vla-pline-object
  105.           )

  106.           (T (Create-New-Poly-Type vla-pline-object acSimplePoly))
  107.     )
  108.   )
  109. ) ;_ end of vla-Pline->Pline-Decurve
  110. ;;; ------------------------------------------------------------------------
  111. (defun c:deCurve ()
  112.   (vla-Pline->Pline-Decurve
  113.     (vlax-ename->vla-object (car (entsel)))
  114.   )
  115.   (princ)
  116. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 137个

财富等级: 日进斗金

发表于 2020-1-17 19:08:45 | 显示全部楼层
学习学习学习学习学习学习学习学习学习学习
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 15:21 , Processed in 0.259866 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表