我需要相同的lisp，但我不想提及层，无论层我需要工具，请帮助我。
这些图层是机密的吗？
你能不能停止恢复线程，开始一个新的线程显示你在寻找什么，如果有人愿意帮助，这将是伟大的，我们应该感谢他们。 嗨，塔瓦，
通常在每张图中，我都会找到不同的图层名称，这就是为什么我没有提到这些名称的原因。
例如，找到附件，你能帮我做HVAC管道的中心线吗。
实例图纸
试试这个草稿，只选择两条线来创建它们之间的中心线（如果我很理解你的目标）
(defun c:cl (/ _Mid ss i sn e1 e2 p1 p2 p3 p4)
(defun *error* (x) (princ "\n *Cancel*"))
(if
(eq
4
(logand 4
(cdr
(assoc 70 (entget (tblobjname "LAYER" (getvar 'clayer))))
)
)
)
(progn
(alert "<!> Current layer is LOCKED <!>")
(exit)
)
)
(defun _Mid (pt1 pt2)
(mapcar (function (lambda (j k) (* (+ j k) 0.5))) pt1 pt2)
)
(if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
(if (eq 2 (setq i (sslength ss)))
t
(progn
(alert "Please select only two lines , OKAY ? ")
nil
)
)
)
(progn
(setq e1 (entget (ssname ss 0))
e2 (entget (ssname ss 1))
p1 (cdr (assoc 10 e1))
p2 (cdr (assoc 11 e1))
p3 (cdr (assoc 10 e2))
p4 (cdr (assoc 11 e2))
)
(if (not (inters p1 p3 p2 p4))
(entmakex (list '(0 . "LINE")
(cons 10 (_Mid p1 p3))
(cons 11 (_Mid p2 p4))
)
)
(entmakex (list '(0 . "LINE")
(cons 10 (_Mid p1 p2))
(cons 11 (_Mid p3 p4))
)
)
)
)
)
(princ "\n Written By Tharwat Al Shoufi")
(princ)
)
哇，非常感谢Tharwat，
它的工作很好，但我需要中心线的“LWPOLYLINE”关闭，也有什么我必须为这些关闭LWPOLYLINE的。任何帮助。。？？？
还有一个请求
我需要每个层的图形文件总数。。。你能帮我一下吗。
不客气。
如果不需要将其作为多段线，请将其分解，并使用我的代码将其居中。
虽然这还不清楚，但我会把这个机会留给另一个人来帮助你。
塔瓦特 再次非常感谢，但对于多段线，u r代码不起作用。 我知道，这就是为什么我在我之前的回复中说，如果你不想把它们作为多段线，就把它们分解。 这是我不久前写的一封信。。。
(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
;; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
;; Alan J. Thompson, 09.29.10
(vl-load-com)
(defun foo (e)
(and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
(not (vlax-curve-isClosed (car e)))
)
)
(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(while
(progn (setvar 'ERRNO 0)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)
(defun _pnts (e / p l)
(if e
(cond ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
(list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
)
((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
(repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
(setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
)
)
)
)
)
(defun _pline (lst)
(if (and (> (length lst) 1)
(entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . ))
(foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
)
(cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
)
)
(defun _lwpline (lst)
(if (> (length lst) 1)
(entmakex (append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
(cons 70 (* (getvar 'plinegen) 128))
)
(mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)
)
)
)
)
(defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
(if
(and
(setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
(setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
(not (initget 0 "Lwpolyline Polyline"))
(setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: <"
(cond (*LBL:Opt*)
((setq *LBL:Opt* "Lwpolyline"))
)
">: "
)
)
)
(*LBL:Opt*)
)
)
)
((if (eq *LBL:Opt* "Lwpolyline")
_lwpline
_pline
)
(vl-remove nil
(mapcar (function (lambda (a b)
(if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
(mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b)
)
)
)
e1
(if (< (_dist (car e1) (car e2))
(_dist (car e1) (last e2))
)
e2
(reverse e2)
)
)
)
)
)
(princ)
) 哇，非常感谢alanjt，它正在工作。
页:
1
[2]