所以我需要先把OBJ转换成VLA对象，然后呢？ 不一定。。。告诉我们，在分层之后，你还需要做什么？
如果这就是全部。您不需要创建另一个选择集
基于Davids准则的构建
(defun c:demo(/ elev ss)
(setq elev 10
ss (ssadd))
(while
(<= elev 10000)
(if (setq temp (ssget "_X"
(List '(0 . "LWPOLYLINE")
'(-4 . "<OR")
(cons 38 elev)
(cons 38 (- elev))
'(-4 . "OR>")
)))
(repeat (setq i (sslength temp))
(ssadd (ssname temp (setq i (1- i))) ss)))
(setq elev (+ elev 10))
) ;_end while
(sssetfirst nil ss)
)
更新 仅此而已-目标是找到所有索引轮廓（10的倍数），并将其设置在特定层上。
我可能也会尝试在不同的层上设置所有剩余的轮廓。
这些等高线都来自导入的GIS数据，并且集合可能很大，因此手动执行此操作几乎是不可能的。
这就是我目前拥有的：
;put 10' contours on correct new layer
(foreach obj SS
(vla-put-layer obj Lay10)
);_end foreach
如果将LWPOLYLINE高程（cdr（assoc 38（entget en））除以10的余数为零
然后将ENAME添加到PICKSET
我内心仍然是一个指挥者：
如果该层存在：
(defun c:topten (/ ss en)
(setq s1 (ssadd))
(and (setq ss (ssget '((0 . "LWPOLYLINE"))))
(while (setq en (ssname ss 0))
(if (zerop (rem (cdr (assoc 38 (entget en))) 10))
(ssadd en s1))
(ssdel en ss)))
s1)
-大卫
哦，天哪。。
(defun c:topten (/en e )
(and (setq ss (ssget '((0 . "LWPOLYLINE"))))
(while (setq en (ssname ss 0))
(if (zerop (rem (cdr (assoc 38 (setq e (entget en)))) 10))
(entmod (subst (cons 8 "E-TOPO-10")
(assoc 8 e) e))
)
(ssdel en ss)))
)
(defun C:SCL (/ *error* msg ELEV SS LAY2 LAY10 DOC UFLAG ALL obj temp)
;layer name used for 10' contours
(setq lay10 "E-TOPO-10")
;layer name used for 2' contours
(setq lay2 "E-TOPO-2")
(vl-load-com)
(setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
;; --{Error Handler Function}--
(defun *error* (msg)
(and uflag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
;; --{Main Function}--
(setq uflag (not (vla-StartUndoMark doc)))
;;; CHECK FOR LAYER AND ADD IF NOT EXIST
(or (tblsearch "LAYER" LAY10)
(vla-add (vla-get-layers doc) LAY10))
(or (tblsearch "LAYER" LAY2)
(vla-add (vla-get-layers doc) LAY2))
;put all obj on 2' contour layer
(setq all (ssget "_X" '((0 . "LWPOLYLINE") )))
(foreach obj all
(vla-put-layer obj LAY2)
);_end foreach
;(find all contours from 10 to 10000 by 10)
(setq elev 10 ss (ssadd))
(while
(<= elev 10000);max elevation searched for is 10,000 feet - change if need be
(if (setq temp (ssget "_X" (List '(0 . "LWPOLYLINE") (cons 38 elev))))
(repeat (setq i (sslength temp))
(ssadd(ssname temp (setq i (1- i))) ss)))
(setq elev (+ elev 10))
);_end while
;put 10' contours on correct new layer
(foreach obj SS
(vla-put-layer obj Lay10)
);_end foreach
;clear ss
(setq ss nil)
(setq all nil)
(setq uFlag (vla-EndUndoMark doc))
(princ)
);_end defun
大卫的荣誉 谢谢你的解释。这很有道理。 that's all - the goal is to find all the index contours (multiples of 10) and set them on a specific layer.
I will probably try to set all the remaining contours on a different layer also.
these contours all come from imported GIS data and the sets can be huge, so doing this manually is all but impossible.
this is what I have at the moment:
(defun C:SCL (/ *error* msg ELEV SS LAY2 LAY10 DOC UFLAG ALL obj temp) ;layer name used for 10' contours (setq lay10 "E-TOPO-10") ;layer name used for 2' contours (setq lay2 "E-TOPO-2") (vl-load-com) (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object))) ;; --{Error Handler Function}-- (defun *error* (msg) (and uflag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) ;; --{Main Function}--(setq uflag (not (vla-StartUndoMark doc))) ;;; CHECK FOR LAYER AND ADD IF NOT EXIST (or (tblsearch "LAYER" LAY10) (vla-add (vla-get-layers doc) LAY10)) (or (tblsearch "LAYER" LAY2) (vla-add (vla-get-layers doc) LAY2)) ;put all obj on 2' contour layer (setq all (ssget "_X" '((0 . "LWPOLYLINE") ))) (foreach obj all (vla-put-layer obj LAY2) );_end foreach;(find all contours from 10 to 10000 by 10) (setq elev 10 ss (ssadd)) (while( (if (zerop (rem (cdr (assoc 38 (entget en))) 10))
IF the remainder of dividing the LWPOLYLINE elevation (cdr (assoc 38 (entget en))) by 10 is zerop
THEN add the ENAME to the PICKSET
I'm still a command guy at heart:
If the layer exists:
(command "_.CHPROP" s1 "" "_LA" "layer_name" "")
-David
Oh man..
(strcat "Lay" (itoa (fix elv)))
(strcat "E-TOPO-" (itoa (fix elv)))
Kudos to David Thanks for the explanation. That makes perfect sense.
页:
1
[2]