在多段线上创建顶点
样本2。图纸大家好，
我有六条折线，其中一条是闭合的。我需要在闭合多段线上创建顶点。随附样品图。要创建的顶点坐标是其他多段线的第一个顶点的坐标。
到目前为止，我只存储了一条多段线起始顶点的坐标。
(vl-load-com)
(setq s1 (car (entsel)))
(setq pl (vlax-ename->vla-object s1))
(defun vlax-list->2D-point(lst)
(if lst
(cons (list (car lst) (cadr lst))
(vlax-list->2D-point (cddr lst)))))
(setq vertCoord(vlax-list->2D-point (vlax-get pl 'Coordinates)))
(setq vertStart (car vertCoord))
谢谢你的帮助。
非常感谢。 如果多段线闭合，以下是3种不同类型的检查：
(if (setq polyline (car (entsel)))
(or
(= 1 (logand 1 (cdr (assoc 70 (entget polyline)))))
(vlax-curve-isClosed polyline)
(eq :vlax-true (vla-get-Closed (vlax-ename->vla-object polyline)))
)
)
有趣的方法可能会有所帮助。谢谢 打开或关闭的工程
; pline co-ords example
; By Alan H
(defun getcoords (ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object ent)
"Coordinates"
)
)
)
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq len (length co-ords))
(setq numb (/ len 2)) ; even and odd check required
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(co-ords2xy) ; list of 2d points making pline
Fwiw。。你已经得到了一些大问题的完整解决方案。是时候开始学习钓鱼了，而不是期待一顿饭。 下面是一个如何将顶点添加到多段线的示例。 OP创建了3个与此问题相关的主题。Ronjonp已经提供了一个解决方案。
你说得对，对不起。我刚刚接触AutoLISP，时间紧迫。但慢慢地掌握了Lisp程序的诀窍
谢谢，比格尔
谢谢你，李。我用的是你的AddLWPolylineVertexV1-0。lsp例程。你能解释一下你的代码吗？我理解不了。
我开始一行一行地分解程序
;;----------------=={ Add LWPolyline Vertex }==---------------;;
;; ;;
;;Adds a new vertex to an LWPolyline at a point specified ;;
;;by the user; compatible with LWPolylines at any ;;
;;orientation, with varying width and arc segments. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Version 1.0 - 17-12-2012 ;;
;; ;;
;;First release. ;;
;;------------------------------------------------------------;;
(defun c:apv ( / a b e h l n p r w x z )
(while ;;inf loop
(progn (setq p (getpoint "\nPick Point for New Vertex: "))
(cond
( (null p) nil) ;; 1st cond - if p not equal 0 return nil
( (null (setq e (nentselp p))) ;; 2nd cond ? The nentselp function returns a 4×4 transformation matrix. What for?
(princ "\nPoint does not lie on an LWPolyline.") ;; so if the returned matrix is empty (nil), print this
)
( (= 4 (length e)) ;; 3rd cond - ??
(princ "\nObject is Nested.") ;; what is nested object?
)
( (/= "LWPOLYLINE" (cdr (assoc 0 (entget (setq e (car e)))))) ;; 4th cond - compare. If not equal...
(princ "\nObject is not an LWPolyline.") ;; ...print this
)
)
)
)
(if (and p e ;; expression returns T if both p and e are not nil, else nil
(setq p (vlax-curve-getclosestpointto e (trans p 1 0)) ;; the UCS is rotated 90 degrees counterclockwise around the WCS Z axis?? Closest point between e and rotated list
n (vlax-curve-getparamatpoint e p) ;; still don't understand what getparamatpoint means
)
)
(if (not (equal n (fix n) 1e-) ;; checks if not equal - n and its truncated value with fuzz distance of 1e-8
(progn
(setq e (entget e)
h (reverse (member (assoc 39 e) (reverse e))) ;; returns list consisting of 14 lists - what for?
l (LM:LWVertices e)
z (assoc 210 e)
)
(repeat (fix n)
(setq a (cons (car l) a)
l (cdr l)
)
)
(setq x (car l)
r (- n (fix n))
w (cdr (assoc 40 x))
w (+ w (* r (- (cdr (assoc 41 x)) w)))
b (atan (cdr (assoc 42 x)))
)
(entmod
(append h
(apply 'append (reverse a))
(list
(assoc 10 x)
(assoc 40 x)
(cons41 w)
(cons42 (tan (* r b)))
)
(list
(cons10 (trans p 0 (cdr z)))
(cons40 w)
(assoc 41 x)
(cons42 (tan (* (- 1.0 r) b)))
)
(apply 'append (cdr l))
(list z)
)
)
)
)
)
(princ)
)
;; Tangent-Lee Mac
;; Args: x - real
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-10))
(/ (sin x) (cos x))
)
)
;; LW Vertices-Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
(if (setq e (member (assoc 10 e) e))
(cons
(list
(assoc 10 e)
(assoc 40 e)
(assoc 41 e)
(assoc 42 e)
)
(LM:LWVertices (cdr e))
)
)
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
页:
[1]
2