我在编写LISP例程方面经验很少,如果有任何帮助,我将不胜感激。
我需要一个LISP来搜索最接近3Dpoly的文本或多行文字字符串,并用该字符串创建一个层;然后将3Dpoly移动到该新层。
我发现了一个类似的lisp,但它只适用于直线和多边形,而不适用于三维多边形。
- (defun c:lin2lay (/
- filter_set
- l2l_inspt
- l2l_linset
- l2l_pt
- l2l_set
- l2l_tol
- l2l_txtset
- )
- (vl-load-com);;added
- (defun filter_ent (ent_type sset)
- (setq filter_set '())
- (foreach
- x
- ent_type
- (setq filter_set
- (append (mapcar '(lambda (y)
- (cdr (assoc -1 y))
- ) ;_ end_lambda
- (vl-remove-if-not
- '(lambda (y)
- (= (cdr (assoc 0 y)) x)
- ) ;_ end_lambda
- (mapcar 'entget
- (vl-remove-if
- 'listp
- (mapcar 'cadr
- (ssnamex sset)
- ) ;_ end_mapcar
- ) ;_ end_vl-remove-if
- ) ;_ end_mapcar
- ) ;_ end_vl-remove-if-not
- ) ;_ end_mapcar
- filter_set
- ) ;_ end_append
- ) ;_ end_setq
- ) ;_ end_foreach
- ) ;_ end_defun
- (if (and (setq l2l_set (ssget '((0 . "LINE,LWPOLYLINE,TEXT,MTEXT"))))
- (setq l2l_tol (getreal "\n>>>...Enter gap tolerance..>>>: "))
- (setq l2l_linset (filter_ent '("LINE" "LWPOLYLINE") l2l_set))
- (setq l2l_txtset
- (filter_ent
- '("TEXT" "MTEXT")
- (car (mapcar '(lambda (x) (ssdel x l2l_set)) l2l_linset)))))
- (progn
- (acet-ui-progress "PROCESSING..." (length l2l_linset))
- (mapcar
- '(lambda (y)
- (setq l2l_pt nil)
- (mapcar
- '(lambda (z)
- (setq l2l_inspt (cdr (assoc 10 (entget z))))
- (if (< (distance
- l2l_inspt
- (vlax-curve-getclosestpointto y l2l_inspt))
- l2l_tol)
- (entmod
- (subst
- (cons 8 (cdr (assoc 1 (entget z))))
- (assoc 8 (entget y))
- (entget y))
- )
- )
- )
- l2l_txtset)
- (acet-ui-progress -1)
- )
- l2l_linset)(acet-ui-progress )))
- (princ))
源代码http://forums.cadalyst.com/showthread.php?t=6313作者:wizman
任何帮助都将不胜感激 |