沿柱脚对齐块
我正在寻找在距离不均匀的pline上放置块的常规方法，例如：前200，
距第一点150’的第二个
3rd 300’等
thx有任何帮助 您可以尝试将这两个LISP组合起来，但它不会将块与直线对齐。。。
Measureplinepnts将在指定距离处创建autocad点。然后可以使用replacepoints将所述点替换为块，但正如我所说的，它不会将它们与直线对齐。
测量点。lsp
替换点。lsp 试试这个……：-）
;;;WIZMAN 01DEC08
(vl-load-com)
(defun c:balign (/ bal_blk bal_blk_ent bal_dist bal_ent bal_ent_sp bal_tot_dist)
(if
(and
(not
(while
(not
(and
(or
(setq
bal_ent (entsel "\n>>>...Pick Polyline, Line or Spline...<<<")
) ;_ end_setq
(princ "\n>>>...Missed, Try again...<<<")
) ;_ end_or
(if bal_ent
(or
(member (cdr (assoc 0 (entget (car bal_ent))))
'("LWPOLYLINE" "SPLINE" "LINE")
) ;_ end_member
(not
(princ "\n>>>...Object is not a Line, Polyline, Spline...<<<"
) ;_ end_princ
) ;_ end_not
) ;_ end_or
) ;_ end_if
) ;_ end_and
) ;_ end_not
) ;_ end_while
) ;_ end_not
(not
(while
(not
(and
(or
(setq bal_blk_ent (entsel "\n>>>...Pick Block...<<<"))
(princ "\n>>>...Missed, Try again...<<<")
) ;_ end_or
(if bal_blk_ent
(or
(member (cdr (assoc 0 (entget (car bal_blk_ent))))
'("INSERT")
) ;_ end_member
(not
(princ "\n>>>...Object is not a Block...<<<"
) ;_ end_princ
) ;_ end_not
) ;_ end_or
) ;_ end_if
) ;_ end_and
) ;_ end_not
) ;_ end_while
) ;_ end_not
(setq bal_blk (cdr (assoc 2 (entget (car bal_blk_ent)))))
) ;_ end_and
(progn
(setq bal_ent_sp (vlax-curve-getstartpoint (car bal_ent)))
(setq bal_tot_dist '(+))
(while (setq bal_dist (getreal "\n>>>...Enter Distance...>>>: "))
(if (<= (eval (setq bal_tot_dist (append bal_tot_dist (list bal_dist))))
(vlax-curve-getdistatparam
(car bal_ent)
(vlax-curve-getendparam (car bal_ent))
) ;_ end_vlax-curve-getdistatparam
) ;_ end_<=
(entmake
(list (cons 0 "INSERT")
(cons 2 bal_blk)
(cons 10
(vlax-curve-getpointatdist
(car bal_ent)
(eval bal_tot_dist)
) ;_ end_vlax-curve-getpointatdist
) ;_ end_cons
(cons 41 1)
(cons 42 1)
(cons 43 1)
(cons 50
(angle '(0 0)
(vlax-curve-getFirstDeriv
(car bal_ent)
(vlax-curve-getParamAtPoint
(car bal_ent)
(vlax-curve-getpointatdist
(car bal_ent)
(eval bal_tot_dist)
) ;_ end_vlax-curve-getpointatdist
) ;_ end_vlax-curve-getParamAtPoint
) ;_ end_vlax-curve-getFirstDeriv
) ;_ end_angle
) ;_ end_cons
) ;_ end_list
) ;_ end_entmake
(progn (princ "\n>>>...Distance exceeds Length of Polyline...<<<\n") (exit))
) ;_ end_if
) ;_ end_while
) ;_ end_progn
) ;_ end_if
(princ)
) ;_ end_defun
(prompt "\n>>>...Balign.lsp is now loaded, Type 'Balign' to run command...<<<")
(princ) 由于wizman不允许用户退出WHILE循环，因此代码可以简化为：
；；；WIZMAN 01 2008年12月；；mod by CAB（vl load com）（定义c:balign（/bal\u blk bal\u blk\u ent bal\u dist bal\u ent bal\u sp bal\u tot\u dist）（while；仅在nil时退出（not（and；仅当用户选择并为成员时才会返回T）（或（setq bal\u ent（entsel“\n>>>…拾取多段线、直线或样条曲线……缺失，重试……对象不是直线、多段线、样条曲线……拾取块……缺失，重试……对象不是块……输入距离…>>:”）（如果（ 谢谢艾伦，我正在努力，但没有时间完成，因为我去阿联酋看了世界上最大的烟花，这是一项正在进行的工作，您的建议/改进很有价值：
；；；WIZMAN 01DEC08（vl load com）（defun c:balign（/bal\u blk bal\u blk\u ent bal\u dist bal\u ent bal\u ent\u sp bal\u tot\u dist*error*）（defun*error*（msg）（和bal\u ent（not（redraw（car bal\u ent）4））（和bal\u blk\u ent（not（redraw（car bal\u blk\u ent）4））；\uend\u defun（setvar'errno 0）（if（and（not）（while（not）（and（or）（setq bal\u ent（entsel）“\n>>>…拾取多段线、直线或样条曲线……缺失，重试……对象不是直线、多段线、样条曲线……拾取块……缺失，重试……对象不是块……输入距离……” ": " ) ;_ end_strcat）；_end_getreal）；_end\u setq（如果bal\u temp（setq bal\u dist bal\u temp）（setq bal\u temp bal\u dist））；\uend_if）；_end\U progn（如果（ 这是完美的thx很多
页:
[1]