[Lisp]需要“hard”l的帮助
你好我需要lisp例程的帮助。
要了解我想要实现的目标，请下载所附的dwg文件。
让我们开始吧。
我的最终目标是获得包含以下数据的列表
((1 17.7656) (2 36.4474) (3 26.4085) (5 59,6297) .... （12 39.9307）（“最后”35.9001）
哪里
1-是从pline开始的第一个块的属性值
17.7656-是指pline的第一个顶点和第一个找到的块之间的距离，该距离沿pline测量
2-是块中下一个属性的值
36.4474-是第一块和第二块之间的距离
5-同上
596297-同上
...
最后-是字符串
35.9001最后选定的块和柱脚末端之间的距离。
距离应该通过pline测量（可能使用vlax curve getDistAtPoint）vlax curve getDistAtPoint的参数可能应该由函数vlax curve getClosestPointTo给出，但这只是我的想法。
第一个问题，如何获取插入点距离我的多段线小于或等于15（在本例中，这可能是另一个距离）的所有块（在attachet dwg文件中称为“块”）。
谢谢你的帮助。
实例图纸 这是一个开始，你需要使用块的插入点，因为我正在做其他事情，希望在未来几天内发布代码。
http://www.cadtutor.net/forum/showthread.php?96642-参考-a-块到道路对齐 感谢回复BIGAL！
我还发现了这条有用的线索：
http://www.cadtutor.net/forum/showthread.php?30556-在每个交点处创建垂直线
下面是我的编码开始。
我的第一个问题解决了-我有一个插入点距离小于或等于给定距离的块实体名称列表。
是时候问第二个问题了。。。如何获取最终列表？
我将在星期一回到这个话题。
同时，如果有人能给我关于第一部分的意见，我将不胜感激！
另外，请向我解释GetPerpendictionalPoint函数是如何工作的，因为我在这篇文章中将GetClosestPoint修改为函数，它可以工作，但我并不完全理解。
(vl-load-com)
;;v2016-05-13
;;ziele_o2k
;;Main function
(defun c:teee ( / EntPline BlocksSS DistForFilterSS BlkEntLst)
(if
(and
(setq
EntPline (car (entsel "\nSelect Main Pline > "));select main pline
BlocksSS (ssget '((0 . "INSERT") (2 . "BLOCK") (66 . 1)));ssget blocks
DistForFilterSS (getreal "\nType offset distance to filter blocks > ");get distance for
)
(member (cdr (assoc 0 (entget EntPline))) '("POLYLINE" "LWPOLYLINE"))
(setq BlkEntLst (PZ:FilterSS EntPline BlocksSS DistForFilterSS))
)
(print BlkEntLst)
(print "No blocks")
)
(princ)
)
;;Function to filter ssget. Returns list of entity names that are perpendicular
;;to selected center, main pline, else nil
(defun PZ:FilterSS (MainPline BlkSS dist / TmpEnts in BlkPt PerpBlkLst)
(setq
TmpEnts
(mapcar
'vlax-vla-object->ename
(vlax-invoke (vlax-ename->vla-object MainPline) 'Explode)
)
)
(repeat (setq in (sslength BlkSS))
(setq BlkPt (cdr (assoc 10 (entget (ssname BlkSS (setq in (1- in)))))))
(if
(and
(getPerpendicularPoint TmpEnts BlkPt)
(<= (distance (getPerpendicularPoint TmpEnts BlkPt) BlkPt) dist)
)
(setq PerpBlkLst (cons (ssname BlkSS in) PerpBlkLst))
nil
)
)
(mapcar '(lambda (x) (vla-delete (vlax-ename->vla-object x))) TmpEnts) ; remove the segments
PerpBlkLst
)
;; modified function from this CAB post
;;http://www.cadtutor.net/forum/showthread.php?30556-Create-Perpendicular-Line-at-every-intersection-point&p=204357&viewfull=1#post204357
(defun getPerpendicularPoint (Ents pt / ent clspt endpts perpts result dist)
(foreach ent Ents
(if
(or
(< (distance (setq clspt (vlax-curve-getclosestpointto ent pt)) (vlax-curve-getstartpoint ent)) 0.0001)
(< (distance clspt (vlax-curve-getendpoint ent)) 0.0001)
)
nil
(setq perpts (cons clspt perpts)) ; else got a perpendicular point
)
)
(setq
perpts
(mapcar
'(lambda(x / tmp)
(cond
((null dist)(setq dist (distance pt x) result x))
((< (setq tmp (distance pt x)) dist)
(setq dist tmp result x))
)
)
perpts
)
)
result
) 谢谢你的代码。它很好，但有一些错误。
我自己写了（基于Tharwat代码：），它对我来说很好。
(defun c:test(/ ss pl ds d lst l srt _att fnl fl out)
;; Tharwat - Date: 14.May.2016 ;;
(cond
((not (setq ss (ssget "_X"
(list '(0 . "INSERT")
'(2 . "Block")
(cons 410 (getvar 'ctab))))))
(princ
"\nCould not find any block named <Block> in this drawing !"))
((not (and (princ "\nPick a LWpolyline:")
(setq pl (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
))
(princ "\nMissed. Try again"))
((setq
ds (getdist
"\nSpecify gap distance between Polyline and blocks :"))
((lambda (i / sn pt cl)
(while (setq sn (ssname ss (setq i (1+ i))))
(setq pt (trans (cdr (assoc 10 (entget sn))) 1 0)
cl (vlax-curve-getclosestpointto (ssname pl 0) pt)
)
(if (<= (distance pt cl) ds)
(setq lst (cons (list sn pt cl) lst))
)
)
)
-1)
(if lst
(progn
(mapcar '(lambda (x)
(setq
l (cons (list (vlax-curve-getdistatpoint
(ssname pl 0)
(caddr x))
(car x))
l)))
lst
)
(setq srt (vl-sort l '(lambda (j k) (< (car j) (car k)))))
(defun _att(e)
(read (vla-get-textstring
(car (vlax-invoke
(vlax-ename->vla-object e)
'getattributes))))
)
(mapcar '(lambda (x)
(if d
(setq fnl (cons (list (_att (cadr x)) (- (car x) d))
fnl)
d (car x)
)
(setq d (car x)
fnl (cons (list (_att (cadr x)) d) fnl)
)
))
srt)
(setq fl(list "last" (cadar fnl))
out (cons fl (cdr fnl))
)
)
)))
(if out
(reverse out)
(princ))
)(vl-load-com)
欢迎对我的代码发表评论！ 首先，你无权从我的密码中删除我的名字。
其次，我的例行程序完全按照您在第一篇帖子中发布的列表执行，并且（您的代码）会打印一个完全不同的列表。
所以，你不应该说错误，但你的错误是，你没有很清楚地描述你的需求。 首先，对不起，先生，把你的名字从代码中删除了。
是的，你的代码有一些我在测试中发现的错误。
1） 首先：
使用附加文件example\u v1尝试您的代码。图纸。lisp返回以下列表（间隙距离等于15）：
(vl-load-com)
;;v2016-05-17
;;ziele_o2k
;;Main function
(defun c:te2 ( / ss pl ds lst1 sl lst2 lst3 srt out)
(cond
(
(not (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "Block") (cons 410 (getvar 'ctab))))))
(princ "\nCould not find any block named <Block> in this drawing !")
);selecting all blocks in drawing
(
(not (and (princ "\nPick a LWpolyline:")(setq pl (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))))
(princ "\nMissed. Try again")
);get main pline
(
(setq ds (getdist "\nSpecify gap distance between Polyline and blocks :"));set distance to filter blocks
(
(lambda (i / sn pt cl)
(while (setq sn (ssname ss (setq i (1+ i))))
(setq
pt (trans (cdr (assoc 10 (entget sn))) 1 0);pt block base point in WCS
cl (vlax-curve-getclosestpointto (ssname pl 0) pt);coordinates of point on curve (in WCS) which is nearest to curve
)
(if
(<= (distance pt cl) ds);filter blocks from ss which are in smaller or eqal distance to given distace
(setq lst1 (cons (list sn pt cl) lst1));make list with ename of block, base point of block and point on curve
)
)
)
-1
)
(if lst1
(progn
(setq sl (PZ:getPolySegs (ssname pl 0)))
(foreach %1 lst1
(
(lambda (%2 / )
(cond
(
(= (vlax-curve-getParamAtPoint (ssname pl 0) (caddr %2))(vlax-curve-getStartParam(ssname pl 0)))
(if
(PZ:IsPerpendicular
(vlax-curve-getPointAtParam (ssname pl 0) (vlax-curve-getStartParam(ssname pl 0)))
(vlax-curve-getPointAtParam (ssname pl 0) (1+ (vlax-curve-getStartParam(ssname pl 0))))
(cadr %2)
(caddr %2)
(cadar sl)
)
(setq lst2 (cons %2 lst2))
)
)
(
(= (vlax-curve-getParamAtPoint (ssname pl 0) (caddr %2))(vlax-curve-getEndParam(ssname pl 0)))
(if
(PZ:IsPerpendicular
(vlax-curve-getPointAtParam (ssname pl 0) (vlax-curve-getEndParam(ssname pl 0)))
(vlax-curve-getPointAtParam (ssname pl 0) (1- (vlax-curve-getEndParam(ssname pl 0))))
(cadr %2)
(caddr %2)
(cadr (last sl))
)
(setq lst2 (cons %2 lst2))
)
)
(T (setq lst2 (cons %2 lst2)))
)
)
%1
)
)
(if lst2
(progn
(mapcar
'(lambda (%1)
(setq lst3 (cons (list (vlax-curve-getdistatpoint(ssname pl 0)(caddr %1))(car %1))lst3))
)
lst2
)
(setq srt (vl-sort lst3 '(lambda (j k) (< (car j) (car k)))))
(defun _att (e)
(read
(vla-get-textstring
(car (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
)
)
)
(mapcar
'(lambda (%)
(setq
out
(cons
(list
(_att (cadr %)) (car %) (- (PZ:GetCurveLength (ssname pl 0)) (car %))
)
out
)
)
)
srt
)
)
)
)
)
)
)
(if out
(setq out (reverse out))
(princ)
)
(terpri)
(princ out)
(princ)
)
;http://www.cadtutor.net/forum/archive/index.php/t-60816.html?
(defun LM:Roundto ( n p / f )
(setq n (- n (setq f (rem n (setq p (expt 10. (- p)))))))
(if (< 0.5 (/ (abs f) p))
((if (minusp n) - +) n p)
n
)
)
;modified from
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length/td-p/817505
(defun PZ:GetCurveLength (curve / )
(vl-load-com)
(vlax-curve-getDistAtParam curve
(vlax-curve-getEndParam curve)
)
)
;verify if segment is perpendicular to pline segment
;segment is given by p3 and p4
;pline segment is given by p1 p2 and b
;if b is not equal 0 then given segment is arc
(defun PZ:IsPerpendicular (p1 p2 p3 p4 b / xu xv yu yv )
(if (not (eq b 0))
(setq
p1 p4
p2 (LM:bulgecentre p1 p2 b)
)
)
(foreach n (list p1 p2 p3 p4) (print n))
(setq
xu (- (car p2) (car p1))
yu (- (cadr p2) (cadr p1))
xv (- (car p4) (car p3))
yv (- (cadr p4) (cadr p3))
)
(if (eq b 0)
(cond
((eq(LM:Roundto(+ (* xu xv) (* yu yv))6)0) (print "perp")T)
(T(print "notperp") nil)
);condition for perpendicular
(cond
((eq(LM:Roundto(- (* xu yv) (* xv yu))6)0)(print "parall")T)
(T (print "notparall")nil)
);condition for parallel
)
)
;modified lisp from
;http://www.lee-mac.com/lisp/html/PolyInfoV1-3.html
;; Bulge Centre-Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b- bulge
;; Returns the centre of the arc described by the given bulge and vertices
(defun LM:bulgecentre ( p1 p2 b )
(polar p1
(+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
(/ (* (distance p1 p2) (1+ (* b b))) 4 b)
)
)
;modified lisp from
;http://www.afralisp.net/autolisp/tutorials/polyline-bulges-part-1.php
(defun PZ:getPolySegs (ent / entl p1 pt bulge seg ptlst)
(cond (ent
(setq entl (entget 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))
)
;; 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))
)
;; reduce list and clear temporary segment
(setq entl(cdr entl)
seg nil
)
)
)
)
;; 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)
)
我不想要第一个元素：（99 0.0）。这个错误在我的第一篇文章中没有明确指出，但我不想浪费你的时间，所以我在修改中修复了它。
2） 第二：
使用文件example\u v2尝试lisp。如果这不是错误，那么我不知道是什么。
你们写的lisp很好，有一些小错误，和我在第一篇文章中问的差不多。当我在包装我的修改时，我改变了这个函数的概念，所以这是我的错，我在发布修改时没有提到这一点。
但受够了，你的代码Tharwat非常有用，如果没有它，我将有很大的问题来实现我的目标
BTW最终代码：
((99 0.0) (1 17.7656) (2 36.4474) (3 26.4085) (5 59.6297) (7 62.222) (8 24.0023) (10 64.0678) (11 21.0495) (12 39.9307) ("last" 35.9001)) ((99 0.0) (1 17.7656) (2 36.4474) (3 26.4085) (5 59.6297) (7 62.222) (8 24.0023) (10 64.0678) (11 21.0495) (12 39.9307) ("last" 35.9001))
----
编辑17.05.2016-最终代码中更改的pt变量定义
例1。图纸
示例2。图纸 没关系，谢谢你为公众澄清这个问题。 你好
我刚刚又看了一遍代码，我认为如果我从你随附的两张图纸中正确地理解了你的观点，你不需要做更多的修改。
试试看，让我知道：
（定义c：测试（/ss pl ds d lst l srt _att fnl out）；；塔尔瓦特-日期：22。也许2016 ;; （cond（（not（setq ss（ssget“_X”（list’（0。“INSERT”）'（2。“Block”）（cons 410（getvar“ctab））））））（princ“\n无法找到此图形中命名的任何块！”）（（not（and（princ“\n点击一条LWpolyline：”）（setq pl（ssget“+：S:E”（（0。“LWpolyline”））））（princ“\n missed.Try again”）（（setq ds（getdist”\n指定多段线和块之间的间隙距离：）（（lambda（i/sn pt cl）（while（setq sn（ssname ss（setq i（1+i））））））（setq pt（cdr（assoc 10（entget sn）））cl（vlax曲线getclosestpointto（ssname pl 0）pt））（如果（ 你有机会尝试我上面发布的最后代码吗？
页:
[1]
2