除法lisp
我还有一个Lisp程序的要求。我需要将许多直线（包括圆弧）等长分割。然而，我正在寻找一种更快（lisp例程将是很棒的）的方法来完成具有特定参数的任务。
在创建所需的总线段长度，然后等长分割完成后，我必须将线段从该分割点向后每侧切割1/4“或3/8”，创建1/2”或3/4“间隙，然后将整个线段的每一端缩短相同的切割长度（1/4或3/8）。这样就可以得到相等的线段，线段之间有间隙。我可以分开做数学运算，创建一条等距线，然后将它们与间隙端对端放置，但这也很耗时，而且对于弧线来说并不适用。
用Lisp程序可以这样做吗？请参阅图片以供参考。x是分界点，在我必须结束的地方，有一个用dims创建的间隙。
谢谢所有的Lisp程序专家。你们太棒了。
RW公司
也许可以从头开始创建线条，而不是修改屏幕上的内容。在使用entmake绘制线段之前，使用getxxx函数提示输入变量。
使用Tapatalk从my Pixel XL发送 我认为你的规则有点生硬，没有双关语的意思，最好是指定所需的数字，并留一个空白，这将给出每个部分的长度。
对此没有太多考虑，但长度=num*dist-（num*2*gap）gap可以吗？否则必须重做dist。
一旦规则制定出来，重做直线和圆弧实际上是最容易的。使用1/4或1/2范围的橡皮筋可能会有问题。如果不满足此规则，会发生什么。
可以在dwg中发布一些示例吗。 我使用Alan Thompson的这个例程沿着一个对象（包括曲线）打断
(defun c:BAD (/ *error* AT:GetSel AT:DrawX _getDist ent pnt cmd undo total add dist break)
;; Break curve At Distance
;; Alan J. Thompson, 09.21.11
;; http://www.theswamp.org/index.php?topic=39550.0;all
(vl-load-com)
(defun *error* (msg)
(and cmd (setvar 'CMDECHO cmd))
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(setvar 'ERRNO 0)
(while
(progn (setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)
(defun AT:DrawX (P C)
;; Draw and "X" vector at specified point
;; P - Placement point for "X"
;; C - Color of "X" (must be integer b/w 1 & 255)
;; Alan J. Thompson, 10.31.09
(if (vl-consp P)
((lambda (d)
(grvecs (cons C
(mapcar (function (lambda (n) (polar P (* n pi) d)))
'(0.25 1.25 0.75 1.75)
)
)
)
P
)
(* (getvar 'viewsize) 0.02)
)
)
)
(defun _getDist (total point / dist)
(and undo (initget "Undo"))
(cond ((not (setq dist (getdist (AT:DrawX point 4)
(strcat
"\nDistance at which to break curve (Total= "
(rtos total)
(if undo
") : "
"): "
)
)
)
)
)
nil
)
((eq dist "Undo") dist)
((not (< 0. dist total))
(princ (strcat "\nValue must be between 0.0 and and " (rtos total) "!"))
(_getDist total point)
)
(dist)
)
)
(vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
(if (setq ent (AT:GetSel
entsel
"\nSelect curve to break: "
(lambda (x)
(and (wcmatch (cdr (assoc 0 (entget (car x))))
"ARC,LINE,*POLYLINE,SPLINE"
)
(not (vlax-curve-isClosed (car x)))
)
)
)
)
(progn
(setq pnt (trans (cadr ent) 1 0)
ent (car ent)
cmd (getvar 'CMDECHO)
)
(setvar 'CMDECHO 0)
(while
(setq
dist (_getDist (setq total (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(setq pnt
(trans (if (> (vlax-curve-getParamAtPoint
ent
(vlax-curve-getClosestPointToProjection ent pnt '(0. 0. 1.))
)
(vlax-curve-getParamAtDist ent (/ total 2.))
)
(progn (setq add total) (vlax-curve-getEndPoint ent))
(progn (setq add 0.) (vlax-curve-getStartPoint ent))
)
0
1
)
)
)
)
(if (eq dist "Undo")
(progn (vl-cmdf "_.U")
(setq ent(caar undo)
pnt(cadar undo)
undo (cdr undo)
)
)
(progn
(setq break (trans (vlax-curve-getPointAtDist ent (abs (- add dist))) 0 1))
(command-s "_.break" ent "_F" "_non" break "_non" break)
(setq undo (cons (list ent pnt) undo))
(and (zerop add) (setq ent (entlast)))
)
)
(redraw)
(foreach p (vl-remove (last undo) undo) (AT:DrawX (cadr p) 1))
)
)
)
(*error* nil)
(princ)
)
页:
[1]