中间的一系列多段线
我需要一个lisp，它将在两个边界多段线之间绘制一系列多段线。多段线序列将与两条边界多段线垂直。请查看图片。下面是一个示例代码，用于在
;; written by Fatty T.O.H. ()2005 * all rights removed
;; edited 5/14/12
;; draw perpendicular lines
;;load ActiveX library
(vl-load-com)
;;local defuns
;;//
(defun start (curve)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
(vlax-curve-getstartpoint curve
)
)
)
)
)
)
;;//
(defun end (curve)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
(vlax-curve-getendpoint curve
)
)
)
)
)
)
;;//
(defun pointoncurve (curve pt)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
pt
)
)
)
)
)
;;//
(defun paramatpoint (curve pt)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getparamatpoint curve
pt
)
)
)
)
)
;;//
(defun distatpt (curve pt)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getdistatpoint curve
(vlax-curve-getclosestpointto curve pt)
)
)
)
)
)
;;//
(defun pointatdist (curve dist)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
(vlax-curve-getpointatdist curve dist)
)
)
)
)
)
;;//
(defun curvelength (curve)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getdistatparam curve
(- (vlax-curve-getendparam curve)
(vlax-curve-getstartparam curve)
)
)
)
)
)
)
;;//
(defun distatparam (curve param)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getdistatparam curve
param
)
)
)
)
)
;;// written by VovKa (Vladimir Kleshev)
(defun gettangent (curve pt)
(setq param (paramatpoint curve pt)
ang ((lambda (deriv)
(if (zerop (cadr deriv))
(/ pi 2)
(atan (apply '/ deriv))
)
)
(cdr (reverse
(vlax-curve-getfirstderiv curve param)
)
)
)
)
ang
)
;;// main program
;;--------------------------------------------------;;
(defun c:DIP (/ *error* acsp adoc cnt div en en2 ent ent2 ip lastp leng ln lnum mul num pt rot sign start step)
(defun *error* (msg)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object))
)
(cond ((or (not msg)
(member msg '("console break" "Function cancelled" "quit / exit abort"))
)
)
((princ (strcat "\nError: " msg)))
)
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
acsp (vla-get-block (vla-get-activelayout adoc))
)
(while (not
(and
(or
(initget 6)
(setq step (getreal "\nEnter step <25>: "))
(if (not step)
(setq step 25.)))
))
(alert "\nEnter a step")
)
(if (and
(setq
ent (entsel
"\nSelect curve near to the start point >>"
)
)
(setq
ent2 (entsel
"\nSelect other curve>>"
)
)
)
(progn
(setq en (car ent)
pt (pointoncurve en (cadr ent))
leng (distatparam en (vlax-curve-getendparam en))
en2 (car ent2)
)
(setq num (fix (/ leng step))
)
(setq div (fix (/ 100. step)
)
)
(setq mul (- leng
(* (setq lnum (fix (/ leng (* step div)))) (* step div))))
(if (not (zerop mul))
(setq lastp T)
(setq lastp nil)
)
(if (> (- (paramatpoint en pt)
(paramatpoint en (vlax-curve-getstartpoint en))
)
(- (paramatpoint en (vlax-curve-getendpoint en))
(paramatpoint en pt)
)
)
(progn
(setq start leng
sign-1
)
)
(progn
(setq start (distatparam en (vlax-curve-getstartparam en))
sign1
)
)
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(setq cnt 0)
(repeat (1+ num)
(setq pt(pointatdist en start)
rot (gettangent en pt)
)
(setq ln (vlax-invoke-method acsp 'addline (setq ip (vlax-3d-point pt))(vlax-3d-point(pointoncurve en2 pt))))
(setq cnt (1+ cnt)
start (+ start (* sign step))
)
)
(if lastp
(progn
(if (= sign -1)
(progn
(setq pt(vlax-curve-getstartpoint en)
rot (gettangent en pt)
)
)
(progn
(setq pt(vlax-curve-getendpoint en)
rot (gettangent en pt)
)
)
)
(setq ln (vlax-invoke-method acsp 'addline (setq ip (vlax-3d-point pt))(vlax-3d-point(pointoncurve en2 pt))))
)
)
)
(princ "\nNothing selected")
)
(*error* nil)
(princ)
)
(prompt "\n >>> Type DIP to execute...")
(prin1)
~'J'~ 除非多段线平行，否则多段线之间的一系列直线只能垂直于其中一条多段线。 代码很好，胖子！读你的代码我学到了很多！
史蒂夫 您还可以在2条样条线之间进行规则漫游，然后提取点值-大卫
谢谢fixo的代码。非常感谢。 很高兴你成功了，
干杯
~'J'~ 谢谢Steve，
很高兴我能帮上忙，
当做
~'J'~ fixo公司
请在主题上帮助我
提前谢谢你
页:
[1]