Fas-连接水平和ve
各位专家，需要lisp快速连接几乎水平或垂直对齐的点。它将要求1）选择第一个点2）向北、向南、向东或向西3）方向左侧或右侧的模糊/公差距离。随附插图。非常感谢。勘误：在标题中，“Fas”应该是“Fast”。谢谢
连接线路。图纸 你有重复的点，所以我做了过度杀戮，而且你的点远离WCS基点（0.0 0.0 0.0），所以我移动了所有实体以适用于我的代码。。。对于模糊因子：1e-2，它对我有效。。。我将附上我的DWG版本。。。
(defun c:fpgl nil (c:fillpointgridwithlines))
(defun c:fillpointgridwithlines ( / osm ape *error* fuzz ss k entpt pt ptlst ptcllst ptcl1 ptcl2 ptcl3 ptcl4 )
(setq osm (getvar 'osmode))
(setq ape (getvar 'aperture))
(setvar 'osmode 0)
(setvar 'aperture 1)
(defun *error* ( msg )
(if osm (setvar 'osmode osm))
(if ape (setvar 'aperture ape))
)
(prompt "\nSelect points for grid connection with lines")
(while (not (setq ss (ssget '((0 . "POINT"))))))
(initget 7)
(setq fuzz (getreal "\nEnter fuzz factor (1e-1...1e-10) : "))
(setq k -1)
(while (and (setq entpt (ssname ss (setq k (1+ k)))) (< k (sslength ss)))
(setq pt (cdr (assoc 10 (entget entpt))))
(setq ptlst (cons pt ptlst))
)
(foreach pt ptlst
(setq ptcl1 (nth 1 (setq ptcllst (vl-sort ptlst '(lambda ( a b ) (< (distance pt a) (distance pt b)))))))
(setq ptcl2 (nth 2 ptcllst))
(setq ptcl3 (nth 3 ptcllst))
(setq ptcl4 (nth 4 ptcllst))
(if (or (equal (angle pt ptcl1) 0.0 fuzz) (equal (angle pt ptcl1) (* 0.5 pi) fuzz) (equal (angle pt ptcl1) pi fuzz) (equal (angle pt ptcl1) (* 1.5 pi) fuzz) (equal (angle pt ptcl1) (* 2.0 pi) fuzz))
(if (not (ssget (mapcar '/ (mapcar '+ pt ptcl1) '(2.0 2.0 2.0)) '((0 . "LINE"))))
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl1)))
)
)
(if (or (equal (angle pt ptcl2) 0.0 fuzz) (equal (angle pt ptcl2) (* 0.5 pi) fuzz) (equal (angle pt ptcl2) pi fuzz) (equal (angle pt ptcl2) (* 1.5 pi) fuzz) (equal (angle pt ptcl2) (* 2.0 pi) fuzz))
(if (not (ssget (mapcar '/ (mapcar '+ pt ptcl2) '(2.0 2.0 2.0)) '((0 . "LINE"))))
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl2)))
)
)
(if (or (equal (angle pt ptcl3) 0.0 fuzz) (equal (angle pt ptcl3) (* 0.5 pi) fuzz) (equal (angle pt ptcl3) pi fuzz) (equal (angle pt ptcl3) (* 1.5 pi) fuzz) (equal (angle pt ptcl3) (* 2.0 pi) fuzz))
(if (not (ssget (mapcar '/ (mapcar '+ pt ptcl3) '(2.0 2.0 2.0)) '((0 . "LINE"))))
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl3)))
)
)
(if (or (equal (angle pt ptcl4) 0.0 fuzz) (equal (angle pt ptcl4) (* 0.5 pi) fuzz) (equal (angle pt ptcl4) pi fuzz) (equal (angle pt ptcl4) (* 1.5 pi) fuzz) (equal (angle pt ptcl4) (* 2.0 pi) fuzz))
(if (not (ssget (mapcar '/ (mapcar '+ pt ptcl4) '(2.0 2.0 2.0)) '((0 . "LINE"))))
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl4)))
)
)
)
(*error* nil)
(princ)
)
(prompt "\nInvoke c:fillpointgridwithlines with shortcut c:fpgl ; \"Type only\" Command: fpgl")
(princ)
M.R。
连接线-MR.dwg 问候语。Marko即使没有移动实体，它也能在我随附的文件中工作，并减轻了我建议的提示。太棒了
页:
[1]