选择线条，然后进行合成
嗨，李·麦克你能帮我了解ObjectBreakV1-0吗。lsp
你的程序很容易使用。
现在，我想要一个程序。你能帮助我吗？
按顺序选择直线（圆弧、直线、闭合多边形、开放多边形），并根据其交点合成闭合边界线。
有时，“.-BOUNDARY”“A”“B”…）命令不太容易使用。
这是一个未完成的程序代码。
(defun c:tt( / )
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-8))
(/ (sin x) (cos x))
)
)
(defun Get-bulge-by3p ( pt1 pt2 pt3 )
((lambda ( a ) (/ (sin a) (cos a))) (/ (+ (- pi (angle pt2 pt1)) (angle pt2 pt3)) 2))
)
(defun Add-polyarc-by3p ( pt1 pt2 pt3 / ocs )
(entmakex (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")'(090 . 2) '(070 . 0) (cons 010 pt1) (cons 042 (Get-bulge-by3p pt1 pt2 pt3))(cons 010 pt3)))
)
(defun LWVertices ( e )
(if (setq e (member (assoc 10 e) e))
(cons
(list
(assoc 10 e);vertex
(assoc 42 e);bulge
)
(LWVertices (cdr e))
)
)
)
;-----------------Main Start----------------------
(setq LinesTOJoin NIL)
(while(and
(setq sel (entsel "\nSelect object at section to be use:"))
(setq ent (car sel));Select object
(setq bpt (cadr sel));Select point(Select sections that want to keep)
(setq pt1 (getpoint "Pick 1st break point:"))
(setq pt2 (getpoint "Pick 2nd break point:"))
(setq bpt (vlax-curve-getclosestpointto ent bpt))
)
(setq enx (vl-remove-if '(lambda ( x ) (member (car x) '(-1 5 6 8 39 48 62 102 330 370)))(entget ent));dxf
pt1 (vlax-curve-getclosestpointto ent pt1);break start point to curve
pt2 (vlax-curve-getclosestpointto ent pt2);break end point to curve
pa1 (vlax-curve-getparamatpoint ent pt1)
pa2 (vlax-curve-getparamatpoint ent pt2)
pab (vlax-curve-getparamatpoint ent bpt)
)
(if (< pa2 pa1) (mapcar 'set '(pt1 pt2 pa1 pa2) (list pt2 pt1 pa2 pa1)))
(setq typ (cdr (assoc 0 enx)))
(cond
((= "ARC" typ)
(setq LinesTOJoin (cons (Add-polyarc-by3p pt1 bpt pt2)LinesTOJoin))
)
((= "CIRCLE" typ)
(setq LinesTOJoin (cons (Add-polyarc-by3ppt1 bpt pt2)LinesTOJoin))
)
((= "LINE" typ)
(setq LinesTOJoin (cons (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 10 pt2)))LinesTOJoin))
)
((= "LWPOLYLINE" typ)
(setq vtx (LWVertices enx))
(repeat (fix pa1) (setq vtx (cdr vtx)));delete the head
(if (not(equal pa1 (fix pa1) 1e-8))
(setq bul (atan (cdr (assoc 42 (car vtx)))))
)
;(princ "need help..............")
)
)
)
(princ)
) 帮助我：
1.基于交点的自动判断
2.如何在没有“命令”的情况下连接LWD多段线
(defun c:tt( / )
(vl-load-com)
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-8))
(/ (sin x) (cos x))
)
)
(defun Get-bulge-by3p ( pt1 pt2 pt3 )
((lambda ( a ) (/ (sin a) (cos a))) (/ (+ (- pi (angle pt2 pt1)) (angle pt2 pt3)) 2))
)
(defun LWVertices ( e )
(if (setq e (member (assoc 10 e) e))
(cons
(list
(assoc 10 e);vertex
(assoc 42 e);bulge
)
(LWVertices (cdr e))
)
)
)
;-----------------Main Start----------------------
(if(not(tblsearch "layer" "GuideLine"))
(entmake(list(cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord")(cons 2 "GuideLine") (cons 62 8) (cons 70 0) (cons 6 "Continuous")))
)
(setq LinesTOJoin nil BVertices nil)
(while(and
(setq sel (entsel "\nSelect object at section to be use:"))
(setq ent (car sel));Select object
(setq bpt (cadr sel));Select point(Select sections that want to keep)
(setq pt1 (getpoint "Pick 1st break point:"))
(setq pt2 (getpoint "Pick 2nd break point:"))
(setq bpt (vlax-curve-getclosestpointto ent bpt))
)
(setq enx (vl-remove-if '(lambda ( x ) (member (car x) '(-1 5 6 8 39 48 62 102 330 370)))(entget ent));dxf
pt1 (vlax-curve-getclosestpointto ent pt1);break start point to curve
pt2 (vlax-curve-getclosestpointto ent pt2);break end point to curve
pa1 (vlax-curve-getparamatpoint ent pt1)
pa2 (vlax-curve-getparamatpoint ent pt2)
pab (vlax-curve-getparamatpoint ent bpt)
)
(if (< pa2 pa1) (mapcar 'set '(pt1 pt2 pa1 pa2) (list pt2 pt1 pa2 pa1)))
(setq typ (cdr (assoc 0 enx)))
(cond
((= "ARC" typ)
(setq tement(entmakex (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "GuideLine")
'(090 . 2) '(070 . 0) (cons 010 pt1) (cons 042 (Get-bulge-by3p pt1 bpt pt2))(cons 010 pt2))))
setq BVertices
)
((= "CIRCLE" typ)
(setq tement(entmakex (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "GuideLine")
'(090 . 2) '(070 . 0) (cons 010 pt1) (cons 042 (Get-bulge-by3p pt1 bpt pt2))(cons 010 pt2))))
)
((= "LINE" typ)
(setq tement (entmakex (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 8 "GuideLine")
'(090 . 2) '(070 . 0) (cons 010 pt1)(cons 010 pt2))))
)
((= "LWPOLYLINE" typ)
(setq vtx (LWVertices enx))
(setq vl1 nil);the head
(setq vl2 nil);the tail
(repeat (fix pa1)
(setq vl1 (cons (car vtx) vl1)
vtx (cdr vtx)
)
)
(if (not (equal pa1 (fix pa1) 1e-8))
(setq vx1 (car vtx)
bul (atan (cdr (assoc 42 vx1)))
vl1 (vl-list*
(list (cons 10 pt1) '(42 . 0.0))
(list (assoc 10 vx1) (cons42 (tan (* (- pa1 (fix pa1)) bul))))
vl1
)
vtx (cons
(list (cons10 pt1) (cons42 (tan (* (- (min pa2 (1+ (fix pa1))) pa1) bul))))
(cdr vtx)
)
)
)
(setq vl1 (cons (car vtx) vl1))
(setq vtx (reverse vtx))
(repeat (+ (length vtx) (fix pa1) (- (fix pa2)) -1)
(setq vl2 (cons (car vtx) vl2)
vtx (cdr vtx)
)
)
(if (not (equal pa2 (fix pa2) 1e-8))
(setq vx1 (car vtx)
bul (atan (cdr (assoc 42 vx1)))
vl2 (cons
(list(cons10 pt2) (cons42 (tan (* (/ (- (1+ (fix pa2)) pa2) (if (< (fix pa2) pa1) (- pa2 pa1) 1.0)) bul))))
vl2
)
vtx (vl-list*
(list (cons 10 pt2) '(42 . 0.0))
(list (assoc 10 vx1) (cons42 (tan (* (if (< (fix pa2) pa1) 1.0 (- pa2 (fix pa2))) bul))))
(cdr vtx)
)
)
(setq vl2 (cons (car vtx) vl2))
)
(if (<= pa1 pab pa2)
(setq vtx(reverse vtx))
(if (vlax-curve-isclosed ent)
(setq vtx(append vl2 (reverse vl1)))
(setq vtx(reverse vtx))
)
)
(setq tement(entmakex (append
(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 8 "GuideLine")(cons 90 (length vtx)))
(apply 'append vtx)
)
)
)
)
)
(vla-put-color (vlax-ename->vla-object tement) 1)
(vla-highlight (vlax-ename->vla-object tement) :VLAX-TRUE)
(setq LinesTOJoin (cons tement LinesTOJoin))
)
(if (> (length LinesTOJoin) 0)
(progn
(setq ss(ssadd))
(foreach n LinesTOJoin
(setq ss(ssadd n ss))
)
(COMMAND "PEDIT" "M" SS "" "J" "J" "E" "0.1" "")
)
)
(princ)
)
页:
[1]