线型手柄
你好三个月来，我一直在学习lisps。
我有一个想法，完成了90%，我遇到了难题。
这是一个演示
问题
看不见的线是虚线，好的，没问题。
可见线必须是连续的，而不是虚线。
(defun c:pps(/ mm_lay pi2 2pi 3pi2 les i pltlr pltud clt plt
obj info ac0 dr40 pt10 starc edarc pt11 pt10s p10
n alist alist1 alist2 lft rht upt dnt cor1 cor2 cor3
cor4 pcenter locat key xcor1 xcor2 xcor3 xcor4 plistn
loc1 loc2 locat2 locn1 locn2 lcline0 clocat clocat2
lcline1 lcline2 celine0 celine1 celine2 pt1 pt2
oldline pt1 pt2 pt3 pt0 *error* erases mvs vxs)
(defun erases (ss / i)
(setq i -1)
(repeat (sslength ss)
(entdel (ssname ss (setq i (1+ i))))
)
)
(defun mvs (lst / a lst2)
(while (setq a (car lst) lst2 (cons a lst2) lst (vl-remove a lst)))
(reverse lst2)
)
(defun vxs (e / i v lst)
(setq i -1)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)
(defun *error*(s)
(setvar 'cmdecho 0)
(command "_.undo" "e")
(setvar 'cmdecho 1)
(redraw)
)
(if (null (tblsearch "layer" "03centreline"))
(progn (setq mm_lay (getvar "CLAYER"))
(setvar "cmdecho" 0)
(command "_layer" "m" "03centreline" "c" "1" "" "l" "center" "" "lw" "0.18" "03centreline" "")
(setvar "cmdecho" 1)
(setvar "clayer" mm_lay)
)
)
(if (null (tblsearch "layer" "04dashed"))
(progn (setq mm_lay (getvar "CLAYER"))
(setvar "cmdecho" 0)
(command "_layer" "m" "04dashed" "c" "2" "" "l" "DASHED" "" "lw" "0.18" "04dashed" "")
(setvar "cmdecho" 1)
(setvar "clayer" mm_lay)
)
)
(setq pi2 (/ pi 2))
(setq 2pi (* pi 2))
(setq 3pi2 (/ (* 3 pi) 2))
(setq les (ssget '((0 . "LINE,CIRCLE,ARC,LWPOLYLINE")
(-4 . "<NOT")
(8 . "*03centreline*")
(-4 . "NOT>")
)
)
)
(setq i 0)
(repeat (sslength les)
(setq obj (ssname les i))
(setq info (entget obj))
(setq ac0 (cdr (assoc 0 info)))
(cond
((= ac0 "CIRCLE")
(progn
(setq dr40 (cdr (assoc 40 info)))
(setq pt10 (cdr (assoc 10 info)))
(setq clt (cons pt10 clt))
(setq pltlr (cons (polar pt10 0 dr40)
(cons (polar pt10 pi dr40) pltlr)
)
)
(setq pltud (cons (polar pt10 pi2 dr40)
(cons (polar pt10 3pi2 dr40) pltud)
)
)
);end_progn
)
((= ac0 "ARC")
(setq dr40 (cdr (assoc 40 info)))
(setq pt10 (cdr (assoc 10 info)))
;; (setq clt (cons pt10 clt))
(setq starc (cdr (assoc 50 info)))
(setq edarc (cdr (assoc 51 info)))
(if
(or
(and (= starc 0) (= edarc pi))
(and (= starc pi) (= edarc 0))
(and (= starc pi2) (= edarc 3pi2))
(and (= starc 3pi2) (= edarc pi2))
)
(setq clt (cons pt10 clt))
)
(cond
((or
(and (<= starc pi2) (<= pi2 edarc) (< edarc 3pi2))
(and (<= pi2 edarc) (< edarc 3pi2 starc))
)
(setq pltud (cons (polar pt10 pi2 dr40) pltud))
)
((or
(and (<= starc pi2) (>= edarc 3pi2))
(and (<= starc pi2) (< edarc pi2))
(and (> starc 3pi2) (>= edarc 3pi2))
)
(setq pltud (cons (polar pt10 pi2 dr40)
(cons (polar pt10 3pi2 dr40) pltud)
)
)
)
((<= pi2 edarc starc 3pi2)
(setq pltud (cons (polar pt10 pi2 dr40)
(cons (polar pt10 3pi2 dr40) pltud)
)
)
)
((and
(> starc pi2)
(<= starc 3pi2)
(or (>= edarc 3pi2) (and (>= edarc 0) (< edarc pi2)))
)
(setq pltud (cons (polar pt10 3pi2 dr40) pltud))
)
)
(cond
((and (<= starc pi edarc) (> starc 0))
(setq pltlr (cons (polar pt10 pi dr40) pltlr))
)
((<= pi edarc starc)
(setq pltlr (cons (polar pt10 0 dr40)
(cons (polar pt10 pi dr40) pltlr)
)
)
)
((>= pi starc edarc)
(setq pltlr (cons (polar pt10 0 dr40)
(cons (polar pt10 pi dr40) pltlr)
)
)
)
((< edarc pi starc)
(setq pltlr (cons (polar pt10 0 dr40) pltlr))
)
)
)
((= ac0 "LINE")
(setq pt10 (cdr (assoc 10 info)))
(setq pt11 (cdr (assoc 11 info)))
(setq plt (cons pt10 (cons pt11 plt)))
)
((= ac0 "LWPOLYLINE")
(setq pt10s (vxs obj))
(setq plt (append pt10s plt))
)
);end_cond
(setq i (1+ i))
);end_repeat
(setq alist (append plt pltlr pltud))
(setq
alist1
(vl-sort alist
(function (lambda (e1 e2) (< (car e1) (car e2))))
)
)
(setq lft (car alist1))
(setq rht (car (reverse alist1)))
(setq alist2
(vl-sort alist
(function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
)
)
(setq upt (car alist2))
(setq dnt (car (reverse alist2)))
(setq alist1 (mvs alist1))
(setq alist2 (mvs alist2))
(setq cor1 (mapcar '+
(mapcar '* lft '(1 0 1))
(mapcar '* upt '(0 1 1))
)
)
(setq cor2 (mapcar '+
(mapcar '* lft '(1 0 1))
(mapcar '* dnt '(0 1 1))
)
)
(setq cor3 (mapcar '+
(mapcar '* rht '(1 0 1))
(mapcar '* upt '(0 1 1))
)
)
(setq cor4 (mapcar '+
(mapcar '* rht '(1 0 1))
(mapcar '* dnt '(0 1 1))
)
)
(setq pcenter (inters cor1 cor4 cor3 cor2 nil))
(setq locat (getpoint pcenter "\nProjection position:"))
(if (> (abs (- (car locat) (car pcenter)))
(abs (- (cadr locat) (cadr pcenter)))
)
(setq key 0)
;;;x dir
(setq key 1)
;;;y dir
)
(cond
((= key 0)
(setq
xcor1 (mapcar '+ cor1 '(99999 0 0))
xcor2 (mapcar '+ cor2 '(99999 0 0))
xcor3 (mapcar '+ cor3 '(-99999 0 0))
xcor4 (mapcar '+ cor4 '(-99999 0 0))
)
(grdraw xcor1 xcor3 1 1)
(grdraw xcor2 xcor4 1 1)
)
((= key 1)
(setq
xcor1 (mapcar '+ cor1 '(0 99999 0))
xcor2 (mapcar '+ cor2 '(0 -99999 0))
xcor3 (mapcar '+ cor3 '(0 99999 0))
xcor4 (mapcar '+ cor4 '(0 -99999 0))
)
(grdraw xcor1 xcor2 1 1)
(grdraw xcor3 xcor4 1 1)
)
);end_cond
(cond
((= key 0)
(setq plistn (append plt pltud))
(setq loc1(mapcar '+
(mapcar '* locat '(1 0 1))
(mapcar '* upt '(0 1 1))
)
)
(setq loc2 (mapcar '+
(mapcar '* locat '(1 0 1))
(mapcar '* dnt '(0 1 1))
)
)
)
((= key 1)
(setq plistn (append plt pltlr))
(setq loc1 (mapcar '+
(mapcar '* locat '(0 1 1))
(mapcar '* lft '(1 0 1))
)
)
(setq loc2 (mapcar '+
(mapcar '* locat '(0 1 1))
(mapcar '* rht '(1 0 1))
)
)
)
);end_cond
(grdraw loc1 loc1 1 1)
(setq locat2 (getpoint locat "\nWidth:"))
(cond
((= key 0)
(setq locn1 (mapcar '+
(mapcar '* locat2 '(1 0 1))
(mapcar '* upt '(0 1 1))
)
)
(setq locn2 (mapcar '+
(mapcar '* locat2 '(1 0 1))
(mapcar '* dnt '(0 1 1))
)
)
(setq lcline0 (mapcar '(lambda (x) (mapcar '* x '(0 1 1))) plistn))
(if (> (car locat) (car locat2))
(setq clocatlocat
clocat2 locat2
)
(setq clocatlocat2
clocat2 locat
)
)
(setq lcline1
(mapcar
'(lambda (x) (mapcar '+ x (mapcar '* locat '(1 0 1))))
lcline0
)
)
(setq lcline2
(mapcar
'(lambda (x) (mapcar '+ x (mapcar '* locat2 '(1 0 1))))
lcline0
)
)
(setq celine0 (mapcar '(lambda (x) (mapcar '* x '(0 1 1))) clt))
(setq celine1
(mapcar
'(lambda (x)
(mapcar '+ x '(10 0 0) (mapcar '* clocat '(1 0 1)))
)
celine0
)
)
(setq
celine2 (mapcar '(lambda (x)
(mapcar '+
x
'(-10 0 0)
(mapcar '* clocat2 '(1 0 1))
)
)
celine0
)
)
)
((= key 1)
(setq locn1 (mapcar '+
(mapcar '* locat2 '(0 1 1))
(mapcar '* lft '(1 0 1))
)
)
(setq locn2 (mapcar '+
(mapcar '* locat2 '(0 1 1))
(mapcar '* rht '(1 0 1))
)
)
(setq
lcline0 (mapcar '(lambda (x) (mapcar '* x '(1 0 1))) plistn))
(if (> (cadr locat) (cadr locat2))
(setq clocatlocat
clocat2 locat2
)
(setq clocatlocat2
clocat2 locat
)
)
(setq lcline1
(mapcar
'(lambda (x) (mapcar '+ x (mapcar '* locat '(0 1 1))))
lcline0
)
)
(setq lcline2
(mapcar
'(lambda (x) (mapcar '+ x (mapcar '* locat2 '(0 1 1))))
lcline0
)
)
(setq celine0 (mapcar '(lambda (x) (mapcar '* x '(1 0 1))) clt))
(setq celine1
(mapcar
'(lambda (x)
(mapcar '+ x '(0 10 0) (mapcar '* clocat '(0 1 1)))
)
celine0
)
)
(setq
celine2 (mapcar '(lambda (x)
(mapcar '+
x
'(0 -10 0)
(mapcar '* clocat2 '(0 1 1))
)
)
celine0
)
)
)
)
(grdraw locn1 locn1 1 1)
(setvar "cmdecho" 0)
(command "_.undo" "be")
(entmake (list '(0 . "line")
'(8 . "0")
(cons 10 loc1)
(cons 11 loc2)
)
)
(entmake (list '(0 . "line")
'(8 . "0")
(cons 10 locn1)
(cons 11 locn2)
)
)
(repeat
(length plistn)
(setq pt1 (car lcline1))
(setq lcline1 (cdr lcline1))
(setq pt2 (car lcline2))
(setq lcline2 (cdr lcline2))
(setq oldline (ssget "_w" pt1 pt2))
(if (and (/= oldline nil) (/= (sslength oldline) 0))
(erases oldline)
)
(entmake (list '(0 . "line")
'(8 . "04dashed")
(cons 10 pt1)
(cons 11 pt2)
)
)
)
(repeat (length clt)
(setq pt1 (car celine1))
(setq celine1 (cdr celine1))
(setq pt2 (car celine2))
(setq celine2 (cdr celine2))
(setq oldline (ssget "_w" pt1 pt2))
(if (and (/= oldline nil) (/= (sslength oldline) 0))
(erases oldline)
)
(entmake (list '(0 . "line")
'(8 . "03centreline")
(cons 10 pt1)
(cons 11 pt2)
)
)
)
(setq oldline (ssget "_w" loc1 locn1))
(if (and (/= oldline nil) (/= (sslength oldline) 0))
(erases oldline)
)
(entmake (list '(0 . "line")
'(8 . "0")
(cons 10 loc1)
(cons 11 locn1)
)
)
(setq oldline (ssget "_w" loc2 locn2))
(if (and (/= oldline nil) (/= (sslength oldline) 0))
(erases oldline)
)
(entmake (list '(0 . "line")
'(8 . "0")
(cons 10 loc2)
(cons 11 locn2)
)
)
(command "_.undo" "e")
(setvar "cmdecho" 0)
(prin1)
)
预测lsp 要么两者都应该是虚线，要么两者都应该是连续的，或者第三个。。。从左边看，你正在投影右侧，所以根据你的判断，破折号在第一张图片上是可以的，然后你正在从顶部向下投影，这样边缘是可见的。。。你应该采取某种标准的投影方式——如果你像在动画gif上那样进行投影，那就好了，但是你应该考虑可见性问题。。。你总是这样投影简单的几何形状吗。。。如果是这种情况，那么考虑将包围盒矩形化，并将其求交为形状。。。用你的投影方式，如果点-接合盒和形状之间的交点在接合盒的左/上边缘，那么投影线应该是连续的，相反的，如果在右/下边缘，那么它应该是虚线。。。与边框矩形不相交的点总是虚线。。。因此，当构建点列表以投影列表的生成元素（（x y z）“cont”）或（（x y z）“dash”）时，您可以获得正确的（cadr listelement）键，根据哪个例程应确定在生成线实体时应使用何种类型的线层。。。 @马尔科·里巴
谢谢你的回复。看起来很复杂，超出了我的能力。
如果有人感兴趣，请帮我修改。谢谢 Rosamund，听着，我不能修改你的代码，但幸运的是，我的库中有一个类似的代码，我认为它比你的更好。。。我会附上我的lisp和动画gif。。。HTH，M.R。
statproj。lsp
@马尔科·里巴
谢谢你的支持，你的演示太小了。不能放大？
页:
[1]