求帮改CAD lsp
(defunc:zxx(/v1v2v3ssninenendataentypecenptrbldistptlistp1p2p3p4pt1pt2pt3pt4);获得点p1和p...
(defun c:zxx (/ v1 v2 v3 ss n in en endata entype cenpt r
b l dist ptlist p1 p2 p3 p4 pt1 pt2 pt3 pt4 )
;获得点p1和p2两点的中点坐标
(defun MidPof2P (p1 p2)
(mapcar '(lambda(x y) (/ (+ x y) 2.0) ) p1 p2)
)
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))
(setq v3 (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ "\n选择要加中心线的圆、圆弧、")
(if (setq ss (ssget (list(cons 0 "ARC,CIRCLE,ELLIPSE,LWPOLYLINE"))))
(progn
(setq n (sslength ss) in 0)
(repeat n
(setq en (ssname ss in) in (1+ in))
(setq endata (entget en))
(setq entype (cdr (assoc 0 endata)))
(cond
((or (= "CIRCLE" entype) (= "ARC" entype)) ;圆、圆弧
(setq cenpt (cdr (assoc 10 endata)))
(setq r (cdr (assoc 40 endata)))
(setq dist (* r 0.4))
(setq pt1 (polar cenpt pi (+ dist r))
pt2 (polar cenpt 0 (+ dist r))
pt3 (polar cenpt (* 0.5 pi) (+ dist r))
pt4 (polar cenpt (* 1.5 pi) (+ dist r))
)
)
((and (= "LWPOLYLINE" entype) (= (cdr (assoc 90 (entget en))) 4)) ;矩形
(setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) endata))
(setq ptlist (mapcar 'cdr ptlist)
p1 (nth 0 ptlist)
p2 (nth 1 ptlist)
p3 (nth 2 ptlist)
p4 (nth 3 ptlist)
)
(setq
b (distance p1 p2)
l (distance p1 p4)
pt1 (MidPof2P p1 p2)
pt2 (MidPof2P p3 p4)
pt3 (MidPof2P p1 p4)
pt4 (MidPof2P p2 p3)
)
(if (< b l)
(setq dist (* b 0.2))
(setq dist (* l 0.2))
)
(setq
pt1 (polar pt1 (angle pt2 pt1) dist)
pt2 (polar pt2 (angle pt1 pt2) dist)
pt3 (polar pt3 (angle pt4 pt3) dist)
pt4 (polar pt4 (angle pt3 pt4) dist)
)
)
)
(if (and pt1 pt2 pt3 pt4)
(progn
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 2 "" "l" "center2" "" "lw"
0.18 "" "")
)
(command "layer" "s" "cen" "")
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(setvar "clayer" v3)
)
)
)
)
)
(setvar "osmode" v1)
(setvar "cmdecho" v2)
(princ)
)
是个画中心线的LSP,求添加一功能,在框选的两两平行线中间画一条中心线,中心线两端比原平行线长十分之一 展开
b l dist ptlist p1 p2 p3 p4 pt1 pt2 pt3 pt4 )
;获得点p1和p2两点的中点坐标
(defun MidPof2P (p1 p2)
(mapcar '(lambda(x y) (/ (+ x y) 2.0) ) p1 p2)
)
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))
(setq v3 (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ "\n选择要加中心线的圆、圆弧、")
(if (setq ss (ssget (list(cons 0 "ARC,CIRCLE,ELLIPSE,LWPOLYLINE"))))
(progn
(setq n (sslength ss) in 0)
(repeat n
(setq en (ssname ss in) in (1+ in))
(setq endata (entget en))
(setq entype (cdr (assoc 0 endata)))
(cond
((or (= "CIRCLE" entype) (= "ARC" entype)) ;圆、圆弧
(setq cenpt (cdr (assoc 10 endata)))
(setq r (cdr (assoc 40 endata)))
(setq dist (* r 0.4))
(setq pt1 (polar cenpt pi (+ dist r))
pt2 (polar cenpt 0 (+ dist r))
pt3 (polar cenpt (* 0.5 pi) (+ dist r))
pt4 (polar cenpt (* 1.5 pi) (+ dist r))
)
)
((and (= "LWPOLYLINE" entype) (= (cdr (assoc 90 (entget en))) 4)) ;矩形
(setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) endata))
(setq ptlist (mapcar 'cdr ptlist)
p1 (nth 0 ptlist)
p2 (nth 1 ptlist)
p3 (nth 2 ptlist)
p4 (nth 3 ptlist)
)
(setq
b (distance p1 p2)
l (distance p1 p4)
pt1 (MidPof2P p1 p2)
pt2 (MidPof2P p3 p4)
pt3 (MidPof2P p1 p4)
pt4 (MidPof2P p2 p3)
)
(if (< b l)
(setq dist (* b 0.2))
(setq dist (* l 0.2))
)
(setq
pt1 (polar pt1 (angle pt2 pt1) dist)
pt2 (polar pt2 (angle pt1 pt2) dist)
pt3 (polar pt3 (angle pt4 pt3) dist)
pt4 (polar pt4 (angle pt3 pt4) dist)
)
)
)
(if (and pt1 pt2 pt3 pt4)
(progn
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 2 "" "l" "center2" "" "lw"
0.18 "" "")
)
(command "layer" "s" "cen" "")
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(setvar "clayer" v3)
)
)
)
)
)
(setvar "osmode" v1)
(setvar "cmdecho" v2)
(princ)
)
是个画中心线的LSP,求添加一功能,在框选的两两平行线中间画一条中心线,中心线两端比原平行线长十分之一 展开
1个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询