需要有关顶点的帮助
提前感谢您的帮助。lisp无法提供我需要的所有应用程序，但我选择了多段线，并列出了所有点和包含多段线的半径
(defun c:test1 ( ); / e i n s x
(if (setq s (ssget "x" '((0 . "LWPOLYLINE")(8 . "DDD"))))
(progn
(setq i 0
n (sslength s)
)
(while (< i n)
(setq e (ssname s i)
x (cdr (assoc 10 (entget e)))
i (1+ i)
)
(print x)
);end wile
);end progn
);end if
(princ)
);end defun
我找到了下面的代码，但我意识到不能更改，以帮助我，我需要给我的点多段线弧半径接近，但不是如果它包含
(defun getPolySegs (/ ent entl p1 pt bulge seg ptlst)
(setvar "ERRNO" 0)
;; repeat request for polyline until user either picks
;; a polyline or exits without picking
(while (and (not ent) (/= (getvar "ERRNO") 52))
(if (and (setq ent (car (entsel "\nSelect polyline: ")))
(/= (cdr (assoc 0 (setq entl (entget ent)))) "LWPOLYLINE")
)
(setq ent nil)
)
); end while
(cond (ent ;; save start point if polyline is closed
(if (= (logand (cdr (assoc 70 entl)) 1) 1)
(setq p1 (cdr (assoc 10 entl)))
)
;; run thru entity list to collect list of segments
(while (setq entl (member (assoc 10 entl) entl))
;; if segment then add to list
(if (and pt bulge)
(setq seg (list pt bulge))
); end if
;; save next point and bulge
(setq pt (cdr (assoc 10 entl))
bulge (cdr (assoc 42 entl))
)
;; if segment is build then add last point to segment
;; and add segment to list
(if seg
(setq seg (append seg (list pt))
ptlst (cons seg ptlst))
); end if
;; reduce list and clear temporary segment
(setq entl(cdr entl)
seg nil
)
); end while
)
); end cond
;; if polyline is closed then add closing segment to list
(if p1 (setq ptlst (cons (list pt bulge p1) ptlst)))
;; reverse and return list of segments
(reverse ptlst)
); end defun
我还找到了lisp例程，列出半径，但没有点
(defun getArcInfo (segment / a p1 bulge p2 c c|2 gamma midp p phi r r2 s theta)
;; assign variables to values in argument
(mapcar 'set '(p1 bulge p2) segment)
;; find included angle
;; remember that bulge is negative if drawn clockwise
(setq theta (* 4.0 (atan (abs bulge))))
;; output included angle
(princ (strcat "\n Included angle: " (rtos theta)" rad ("(angtos theta 0)" degrees)"))
;; find height of the arc
(setq c (distance p1 p2) s (* (/ c 2.0) (abs bulge)))
;; output height of arc
(princ (strcat "\n Height of arc:" (rtos s)))
;; output chord length
(princ (strcat "\n Chord length: " (rtos c)))
;; If this function is used without making sure that the segment
;; is not simply a line segment (bulge = 0.0), it will produce
;; a division-by-zero error in the following. Therefore we want
;; to be sure that it doesn't process line segments.
(cond ((not (equal bulge 0.0 1E-6))
;; find radius of arc
;; first find half the chord length
(setq c|2 (/ c 2.0)
;; find radius with Pythagoras (used as output)
r (/ (+ (expt c|2 2.0) (expt s 2.0)) (* s 2.0))
;; find radius with trigonometry
r2(/ c|2 (sin (/ theta 2.0)))
)
(princ (strcat "\n Radius of arc:" (rtos r)))
;; find center point of arc with angle arithmetic
;; (used as output)
(setq gamma (/ (- pi theta) 2.0)
phi (if (>= bulge 0)
(+ (angle p1 p2) gamma)
(- (angle p1 p2) gamma)
)
p (polar p1 phi r)
)
;; find center point of arc with Pythagoras
(setq a (sqrt (- (expt r 2.0) (expt c|2 2.0)))
midp (polar p1 (angle p1 p2) c|2)
p2 (if (>= bulge 0)
(polar midp (+ (angle p1 p2) (/ pi 2.0)) a)
(polar midp (- (angle p1 p2) (/ pi 2.0)) a)
)
)
;; output coordinates of center point
(princ (strcat "\n Center of arc:"(rtos (car p))","(rtos (cadr p))))
)
(T (princ "\n Segment has no arc info"))
)
(princ)
)
(defun c:POLYARCS (/ a polysegs seg)
;; make a list of polyline segments of a
;; selected polyline
(cond ((setq polysegs (getPolySegs))
;; a is just an informative counter
(setq a 0)
;; run thru each segment
(foreach seg polysegs
(setq a (1+ a))
;; only process the segment if it's an arc
;; i.e. bulge /= 0.0
(cond ((not (zerop (cadr seg)))
(princ (strcat "\nSegment " (itoa a) ": "))
;;
(getArcInfo seg)
)
)
)
)
)
)
但没能把它们放在一个Lisp程序的地方一起做，
我需要给我一个lisp，所有点和半径，都在一个列表中闭合多段线 只需根据下面的代码添加另一个defun，VLISP支持将坐标作为属性，就像长度和面积一样。
(defun plcords (/ ent obj plobs )
(vla-load-com)
(defun getcoords (ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object ent)
"Coordinates"
)
)
)
)
(defun co-ords2xy ( / I)
; 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 numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth (+ I 1) co-ords)(nth I co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
)
(setq plobjs (ssget (list (cons 0 "lwpolyline"))))
(setq numb1 (sslength plobjs))
(setq x numb1)
(repeat numb1
(setq obj (ssname plobjs (setq x (- x 1))))
(setq co-ords (getcoords obj))
)
(co-ords2xy)
(setq inc (length coordsxy))
(repeat (/ inc2)
(setq x (rtos (nth (setq inc (- inc 1)) co-ords) 2 3 ))
(setq y (rtos (nth (setq inc (- inc 1)) co-ords) 2 3 ))
(setq xy (strcat x "," y ))
(princ xy)
(princ "\n ")
)
)
(plcords)
页:
[1]