[转贴]：SelectByPolyline

eachy · 发表于 2003-11-28 00:28:24

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

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

×

(defun SelectByPolyline (/ ent_pl entl_pl pnt ss_pnts item)
(setq ent_pl (car (entsel "\nSelect a polyline")))
(setq entl_pl (entget ent_pl))
(setq ss_pnts nil)
(princ "\nSelected is ")
(foreach item entl_pl
(if (= (car item) 10)
(setq pnt (cdr item)
ss_pnts (append ss_pnts
(list (list (car pnt) (nth 1 pnt) 0.0))
)
)
)
)
(setq ss_ents (ssget "wp" ss_pnts))
)

Test

(defun c:testit (/ ss item entl c1)
(setq ss (SelectByPolyline))
(setq c1 (cons 8 "0"))
(setq i 0)
(repeat (sslength ss)
(setq item (ssname ss i))
(setq entl (entget item))
(setq i (1+ i))
(setq entl (subst c1 (assoc 8 entl) entl))
(entmod entl)
)
(princ)
)

其他几个函数

;;; ------------------------------------------------------------------------
;;; Creates a new polyline based on the existing properties
;;; of the source vla-pline-object
;;;
;;; Note: this function does not check for Xdata or other data
;;; that might be attached to the original entity.
;;;
;;; Neither does it check for an association of the original
;;; object to an object reactor.
;;;
;;; Returns a newly created polyline using the
;;; properties of the source vla-pline-object.
;;;
(defun Create-New-Poly-Type
(vla-pline-object polytype / splined-pline-object)
;; get the coordinates of the pline
(setq splined-pline-object
(vla-AddPolyline
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(vla-get-coordinates vla-pline-object)
)
)
(vla-put-type splined-pline-object PolyType)
;; Transfer some of the properties of the source polyline object
;; to the newly created one.
(foreach Property '("Closed" "Color"
"ConstantWidth" "Linetype"
"LinetypeGeneration"
"LinetypeScale" "Lineweight"
"Normal" "PlotStyleName"
"Thickness" "Visible"
"Elevation"
)
(vlax-put splined-pline-object
Property
(vlax-get vla-pline-object Property)
)
)
;; Erase the source polyline object
(vla-erase vla-pline-object)
;; Return the new polyline object
splined-pline-object
) ;_ end of Create-New-Poly-Type
;;; ------------------------------------------------------------------------
--
;; takes a 3dpoly and curves it like Pedit
;;; (vla-Pline->Pline-Fit-Curve (vlax-ename->vla-object (car (entsel))))
;;; Returns either the modified polyline or a newly created
;;; polyline if it is required.
(defun vla-Pline->Pline-Fit-Curve (vla-pline-object)
(if (member (vla-get-ObjectName vla-pline-object)
'("AcDb3dPolyline" "AcDb2dPolyline" "AcDbPolyline")
)
(cond ((member (vla-get-ObjectName vla-pline-object)
'("AcDb2dPolyline")
)
(vla-put-type vla-pline-object acFitCurvePoly)
vla-pline-object
)
((member (vla-get-ObjectName vla-pline-object)
'("AcDb3dPolyline")
)
(princ "Can not Fit Curve a 3D Polyline")
vla-pline-object
)
(T
(Create-New-Poly-Type vla-pline-object acFitCurvePoly)
)
)
)
) ;_ end of vla-Pline->Pline-Fit-Curve
;;; ------------------------------------------------------------------------
--
(defun c:FitCurve ()
(vla-Pline->Pline-Fit-Curve
(vlax-ename->vla-object (car (entsel)))
)
(princ)
)
;;; ------------------------------------------------------------------------
--
;; decurves a pline
;;; (vla-Pline->Pline-Decurve (vlax-ename->vla-object (car (entsel))))
;;; Returns either the modified polyline or a newly created
;;; polyline if it is required.
(defun vla-Pline->Pline-Decurve (vla-pline-object)
(if (member (vla-get-ObjectName vla-pline-object)
'("AcDb3dPolyline" "AcDb2dPolyline" "AcDbPolyline")
)
(cond ((member (vla-get-ObjectName vla-pline-object)
'("AcDb2dPolyline")
)
(vla-put-type vla-pline-object acSimplePoly)
vla-pline-object
)
((member (vla-get-ObjectName vla-pline-object)
'("AcDb3dPolyline")
)
(princ "Can not Decurve a 3D Polyline")
vla-pline-object
)
(T (Create-New-Poly-Type vla-pline-object acSimplePoly))
)
)
) ;_ end of vla-Pline->Pline-Decurve
;;; ------------------------------------------------------------------------
(defun c:deCurve ()
(vla-Pline->Pline-Decurve
(vlax-ename->vla-object (car (entsel)))
)
(princ)
)

;;; ------------------------------------------------------------------------ 
;;; Creates a new polyline based on the existing properties 
;;; of the source vla-pline-object 
;;; 
;;; Note: this function does not check for Xdata or other data 
;;; that might be attached to the original entity. 
;;; 
;;; Neither does it check for an association of the original 
;;; object to an object reactor. 
;;; 
;;; Returns a newly created polyline using the 
;;; properties of the source vla-pline-object. 
;;; 
(defun Create-New-Poly-Type 
       (vla-pline-object polytype / splined-pline-object) 
  ;; get the coordinates of the pline 
  (setq        splined-pline-object 
         (vla-AddPolyline 
           (vla-get-ModelSpace 
             (vla-get-ActiveDocument 
               (vlax-get-acad-object) 
             ) 
           ) 
           (vla-get-coordinates vla-pline-object) 
         ) 
  ) 
  (vla-put-type splined-pline-object PolyType) 
  ;; Transfer some of the properties of the source polyline object 
  ;; to the newly created one. 
  (foreach Property '("Closed"                 "Color" 
                      "ConstantWidth"         "Linetype" 
                      "LinetypeGeneration" 
                      "LinetypeScale"         "Lineweight" 
                      "Normal"                 "PlotStyleName" 
                      "Thickness"         "Visible" 
                      "Elevation" 
                     ) 
    (vlax-put splined-pline-object 
              Property 
              (vlax-get vla-pline-object Property) 
    ) 
  ) 
  ;; Erase the source polyline object 
  (vla-erase vla-pline-object) 
  ;; Return the new polyline object 
  splined-pline-object 
) ;_ end of Create-New-Poly-Type 
;;; ------------------------------------------------------------------------ 
-- 
;; takes a 3dpoly and curves it like Pedit 
;;; (vla-Pline->Pline-Fit-Curve (vlax-ename->vla-object (car (entsel)))) 
;;; Returns either the modified polyline or a newly created 
;;; polyline if it is required. 
(defun vla-Pline->Pline-Fit-Curve (vla-pline-object) 
  (if (member (vla-get-ObjectName vla-pline-object) 
              '("AcDb3dPolyline" "AcDb2dPolyline" "AcDbPolyline") 
      ) 
    (cond ((member (vla-get-ObjectName vla-pline-object) 
                   '("AcDb2dPolyline") 
           ) 
           (vla-put-type vla-pline-object acFitCurvePoly) 
           vla-pline-object 
          ) 
 
          ((member (vla-get-ObjectName vla-pline-object) 
                   '("AcDb3dPolyline") 
           ) 
           (princ "Can not Fit Curve a 3D Polyline") 
           vla-pline-object 
          ) 
 
          (T 
           (Create-New-Poly-Type vla-pline-object acFitCurvePoly) 
          ) 
    ) 
  ) 
) ;_ end of vla-Pline->Pline-Fit-Curve 
;;; ------------------------------------------------------------------------ 
-- 
(defun c:FitCurve () 
  (vla-Pline->Pline-Fit-Curve 
    (vlax-ename->vla-object (car (entsel))) 
  ) 
  (princ) 
) 
;;; ------------------------------------------------------------------------ 
-- 
;; decurves a pline 
;;; (vla-Pline->Pline-Decurve (vlax-ename->vla-object (car (entsel)))) 
;;; Returns either the modified polyline or a newly created 
;;; polyline if it is required. 
(defun vla-Pline->Pline-Decurve        (vla-pline-object) 
  (if (member (vla-get-ObjectName vla-pline-object) 
              '("AcDb3dPolyline" "AcDb2dPolyline" "AcDbPolyline") 
      ) 
    (cond ((member (vla-get-ObjectName vla-pline-object) 
                   '("AcDb2dPolyline") 
           ) 
           (vla-put-type vla-pline-object acSimplePoly) 
           vla-pline-object 
          ) 
 
          ((member (vla-get-ObjectName vla-pline-object) 
                   '("AcDb3dPolyline") 
           ) 
           (princ "Can not Decurve a 3D Polyline") 
           vla-pline-object 
          ) 
 
          (T (Create-New-Poly-Type vla-pline-object acSimplePoly)) 
    ) 
  ) 
) ;_ end of vla-Pline->Pline-Decurve 
;;; ------------------------------------------------------------------------ 
(defun c:deCurve () 
  (vla-Pline->Pline-Decurve 
    (vlax-ename->vla-object (car (entsel))) 
  ) 
  (princ) 
)

xdcad9819 · 发表于 2020-1-17 19:08:45

学习学习学习学习学习学习学习学习学习学习

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

[转贴]：SelectByPolyline

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

相关帖子