) )
;;3 本程序主程序
(cond ((= (type ssPts) 'PICKSET)
(repeat (setq n (sslength ssPts))
(if (and (setq e (ssname ssPts (setq n (1- n))))
(setq en (entget e))
)
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
) )
(mapcar 'last (sortpts1 lst KEY FUZZ)) )
((Listp ssPts)
(cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
(foreach e ssPts
(if (setq en (entget e))
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
) )
(mapcar 'last (sortpts1 lst KEY FUZZ))
) ) ) ) )
;;*****************************************************************************通用点表排序
;;18 [功能] 集合->列表
;; 示例: (MJ:CollectionList (MJ:GetLtypes)) 返回:线性列表
(defun MJ:CollectionList (Collection / name out)
(vlax-for each Collection
(setq name (MJ:Name each))
(setq out (cons name out)) )
(reverse out) )
;;19 [功能] 线型数量
(defun MJ:CountLtypes ()
(MJ:CollectionCount (vlax-Get-Property *DOC* 'Linetypes)) )
;;20 [功能] 对集合对象的每个成员执行指定函数的操作
;; 示例: (MJ:MapCollection all-arcs 'MJ:DeleteObject)
(defun MJ:MapCollection (Collection qFunction)
(vlax-map-collection Collection qFunction) )
;;20.1 [功能] 显示集合对象每个成员的方法和属性.既然是集合,方法是相同的
;; 示例: (MJ:DumpCollection (MJ:GetLayers))
(defun MJ:DumpCollection (Collection)
(MJ:MapCollection Collection 'vlax-dump-object) )
;;20.2 [功能] 删除对象
;; 示例: (MJ:DeleteObject arc-object1)
(defun MJ:DeleteObject (obj)
(princ \
(cond
((and
(not (vlax-erased-p obj));存在
(vlax-read-enabled-p obj);可读
(vlax-write-enabled-p obj);可写
)
(vlax-invoke-method obj 'Delete)
(if (not (vlax-object-released-p obj))
(vlax-release-object obj);释放
)
)
(T (princ \
) )
;;21.1 [功能] ename->vla对象
;; 示例: (MJ:MakeObject (car (entsel)))
(defun MJ:MakeObject (entname)
(cond
((= (type entname) 'ENAME)
(*En2Obj* entname)
)
((= (type entname) 'VLA-OBJECT)
entname
) ) )
;;21.2 [功能] vla对象->ename
(defun MJ:MakeEname (object)
(if (equal (type object) 'vla-object)
(*Obj2En* object)
object )
)
;;22 [功能] 返回对象名称(见9)
;; 示例: (= \
(defun MJ:ObjectType (obj)
(vlax-get-property obj 'ObjectName) )
;;23.1 编组开始(command \
(defun MJ:UndoBegin ()
(vlax-invoke-method *DOC* 'StartUndoMark) )
;;23.2 编组结束(command \
(defun MJ:UndoEnd ()
(vlax-invoke-method *DOC* 'EndUndoMark) )
;;24 [功能] 用一个对象的属性等修改另一个对象的属性
;;示例(setq source (MJ:MakeObject(car (entsel))) target (MJ:MakeObject(car (entsel))))
;; (MJ:CopyProp \ target)用一个对象的图层等修改另一个对象的图层等
(defun MJ:CopyProp (propName source target)
(cond
((member (strcase propName)
'(\ \ \