删除单个复合线顶点
本帖最后由 陈亚娣 于 2013-11-2 13:05 编辑;;;;删除单个复合线顶点(不是本人编写，只是想跟大家分享)
(defun c:xs1()
(setvar "cmdecho" 0)
(princ "\n删除单个复合线顶点")
(setq a (entsel "\n选择要删除的顶点:"))
;;第一层if开始
(if a (progn
;;第一层progn开始
(setq p1 (cadr a))
(setq p1 (reverse p1))
(setq p1 (cdr p1))
(setq p1 (reverse p1))
(setq xylt (car a))
(setq a2 (entget xylt))
;;第二层if开始
(if (or (= (cdr (ASSOC '0 a2)) "POLYLINE") (= (cdr (ASSOC '0 a2)) "LWPOLYLINE")) (progn
;;第二层progn开始
(setq osvar (getvar "osmode"))
(setvar "osmode" 0)
(setq ss1 (ssget "I"))
(if (and ss1 (= (sslength ss1) 1)) (progn
(setq mmm (cdr (assoc '0 (entget (ssname ss1 0)))))
(if (or (= mmm "POLYLINE") (= mmm "LWPOLYLINE"))
(command "pedit" "")
);if
(if (or (= mmm "ARC") (= mmm "LINE"))
(command)
);if
);progn
);if
(setq ss1 nil)
(xy_lt)
(setq pp1 p1)
(dd_shu)
;;第三层if开始
(if (> (length po_all) 2) (progn
;;第三层progn开始
(if (> ped 129) (command "pedit" xylt "D" ""))
(setq a2 (entget xylt))
(setq tyname (cdr (ASSOC '0 a2)))
(cond ((= tyname "LWPOLYLINE")
(dd_lw)
(if (and (> len 3) (or (= ped 132) (= ped 133))) (command "pedit" xylt "S" ""))
)
((= tyname "POLYLINE")
(dd_po)
)
);cond
(if (and (> len 3) (or (= ped 130) (= ped 131))) (command "pedit" xylt "F" ""))
(if (and (= len 3) (or (= ped 129) (= ped 131) (= ped 133))) (command "pedit" xylt "O" ""))
);progn
;;第三层progn结束
(princ "\n复合线只剩2个顶点，无法删除！")
);if
;;第三层if结束
(setvar "osmode" osvar)
);progn
;;第二层progn结束
(princ "\n选择的不是复合线！")
);if
;;第二层if结束
);progn
;;第一层progn结束
(princ "\n没有选中目标！")
);if
;;第一层if结束
(princ)
);defun
;;----------------------------------------------------------------------
;;删简单复合线函数
(defun dd_lw()
(setq tylist nil len (length a2) tyn (cons 90 (- (cdr (assoc '90 a2)) 1)) n 0 n1 0)
(while (< n len)
(setq tylist1 (nth n a2))
(if (/= (type (cdr tylist1)) (type (list 1 1)))
(if (= tylist nil)
(setq tylist (list tylist1))
(setq tylist (cons tylist1 tylist))
);if
(if (= n1 nn)
(setq n (+ n 3) n1 (+ n1 1))
(setq tylist (cons tylist1 tylist) n1 (+ n1 1))
);if
);if
(setq n (+ n 1))
);while
(setq tylist (subst tyn (assoc '90 tylist) tylist))
(setq n 0 len (length po_all))
(setq tylist (reverse tylist))
(entmod tylist)
);defun
;;--------------------------------------------------------------------------------------
;;删复杂复合线函数
(defun dd_po()
(sh_ch)
(setq n nn len (length po_all))
(if (and (/= n 0) (/= n (- (length po_all) 1))) (setq nn1 (- n 1)nn2 (+ n 1)))
(if (= n 0) (setq nn1 0nn2 (+ n 2) pp (nth (+ n 1) po_all)))
(if (= n (- (length po_all) 1)) (setq nn1 (- n 2)nn2 n pp (nth (- n 1) po_all)))
(command "pedit" xylt "e")
(setq nn 0)
(while (< nn nn1)
(command "")
(setq nn (+ nn 1))
);while
(command "s")
(while (< nn nn2)
(command "")
(setq nn (+ nn 1))
);while
(command "g")
(if (= n 0) (command "m" pp))
(if (= n (- (length po_all) 1)) (command "" "m" pp))
(command "x" "")
(command "zoom" "p")
);defun
;;---------------------------------------------------------------------
;;复合线视窗函数
(defun sh_ch()
(setq p 0)
(while (< p (length po_all))
(setq x (car (nth p po_all)) y (cadr (nth p po_all)))
(if (= p 0) (setq xx x yx y xm x ym y)
(progn
(if (< x xx) (setq xx x))
(if (> x xm) (setq xm x))
(if (< y yx) (setq yx y))
(if (> y ym) (setq ym y))
);progn
);if
(setq p (+ p 1))
);while
(command "zoom" "w" (list (- xx 1) (- yx 1)) (list (+ xm 1) (+ ym 1)))
);defun
;;---------------------------------------------------------------------------
;;;函数,顶点数
(defun dd_shu()
(setq n 0)
(setq nn 0)
(setq pp (nth 0 po_all))
(setq d0 (distance pp pp1))
(while (< n (length po_all))
(setq pp (nth n po_all))
(setq d1 (distance pp pp1))
(if (< d1 d0) (progn
(setq nn n)
(setq d0 d1)
);progn
);if
(setq n (+ n 1))
);while
);defun
;;-----------------------------------------------------------------
(defun xy_lt()
(setq po_all nil)
(setq nst2 (entget xylt))
(setq mmm (cdr (assoc '0 nst2)))
(if (or (= mmm "POLYLINE") (= mmm "LWPOLYLINE")) (progn
(setq ped (cdr (ASSOC '70 nst2)))
(if (< ped 6) (progn
(command "pedit" xylt "l" "on" "")
(setq nst2 (entget xylt))
(setq ped (cdr (ASSOC '70 nst2)))
);progn
);if
(cond ((= mmm "LWPOLYLINE")
(while (> (length nst2) 0)
(setq pp (nth 0 nst2))
(if (and (= (type (cdr pp)) (type (list 10.0 10.0))) (= (nth 0 pp) 10)) (progn
(setq pp (cdr pp))
(setq po_all (reverse po_all))
(setq po_all (cons pp po_all))
(setq po_all (reverse po_all))
)progn
);if
(setq nst2 (cdr nst2))
);while
)
((= mmm "POLYLINE")
(setq nst1 xylt)
(while (and (setq nst1 (entnext nst1)) (/= (cdr (assoc '0 (setq nst2 (ENTGET NST1)))) "SEQEND"))
(if (= (cdr (assoc '70 nst2)) (cdr (assoc '70 (entget (entnext xylt))))) (progn
(setq pp (cdr (assoc '10 nst2)))
(setq pp (reverse pp))
(setq pp (cdr pp))
(setq pp (reverse pp))
(setq po_all (reverse po_all))
(setq po_all (cons pp po_all))
(setq po_all (reverse po_all))
);progn
);if
);while
)
);cond
);progn
);if
);defun
;;------------------------------------------------------------------------------
缺少自定义函数
hehoubin 发表于 2013-10-29 12:20 static/image/common/back.gif
缺少自定义函数
已补上欠缺的自定义函数 觉得太复杂了 本帖最后由 自贡黄明儒 于 2013-11-2 15:11 编辑
仅供参考
;;示例(HH:delLwpolyPt1 (car(setq en(entsel))) (cadr en))
(defun HH:delLwpolyPt1 (en p / ENT L1 L2 P1)
(setq ENT (entget en))
(setq p (vlax-curve-getclosestpointto en (trans p 1 0)))
(setq p1 (HH:PickClosePt en p)) ;离p最近的顶点
(setq p1 (list 10 (car p1) (cadr p1)))
(setq L2 (cdr (member p1 ent))) ;后段
(setq L1 (reverse (cdr (member p1 (reverse ent))))) ;前段
(entmod (append L1 L2))
)
http://bbs.mjtd.com/thread-108149-1-1.html见HH:PickClosePt HH:PickClosePt这个函数没有啊
页:
[1]