测量或分割对象-wit
伙计们，我很好奇，有人知道如何使用命令：测量或分割。
我需要在一条追踪线上分布一个块，但它们之间的空间相同，这些命令会放置距离，因此，当作为参考的对象发生倾斜时，距离跟随对象，但最终距离有一个小错误，因为倾斜度。。。下面我在一些图片中展示了我试图解释的内容，有人知道一个LISP代码可以帮上忙吗？
谢谢
试试这个快速破解：
(defun c:mymeasure ( / di en in ln ob p1 p2 sn sp x1 )
(while
(progn
(setvar 'errno 0) (setq en (car (entsel "\nSelect object to measure: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type en))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list en)))
(princ "\nInvalid object selected.")
)
)
)
)
)
(if (and (= 'ename (type en))
(progn
(initget 6)
(setq di (getdist "\nSpecify length of segment: "))
)
)
(progn
(setq p1 (vlax-curve-getstartpoint en)
p2 (vlax-curve-getendpoint en)
x1 (abs (- (car p2) (car p1)))
sn (fix (/ x1 di))
x1 (+ (min (car p1) (car p2)) (/ (- x1 (* di sn)) 2.0))
ob (vlax-ename->vla-object en)
sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(repeat (1+ sn)
(setq ln (vlax-invoke sp 'addline (list x1 0.0 0.0) (list x1 1.0 0.0)))
(if (setq in (vlax-invoke ob 'intersectwith ln acextendotherentity))
(entmake (list '(0 . "POINT") (list 10 (car in) (cadr in) (caddr in))))
)
(vla-delete ln)
(setq x1 (+ x1 di))
)
)
)
(princ)
)
(vl-load-com) (princ)
这是一个很好的例程，但是我们怎么能用“BLOCKNAME”代替你的“entmake POINT”？
谢谢 哇。。。非常感谢“李麦克”！。。。这正是我需要的！。。。我只需要将点名称交换到一个块，以便在我的应用程序上更快！。。。但是它帮了我很多！！！。。。 不客气
尝试以下操作，更改高亮显示的块名称以适合：
(defun c:mymeasure ( / *error* bd bn cm di en in ln ob p1 p2 sn sp x1 )
(setq bn "myblock") ;; Name of block to insert
(defun *error* ( msg )
(if (and (= 'vla-object (type ln)) (not (vlax-erased-p ln)))
(vl-catch-all-apply 'vla-delete (list ln))
)
(if (= 'int (type cm))
(setvar 'cmdecho cm)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nCurrent layer locked.")
)
( (not
(or (tblsearch "block" bn)
(and (setq bd (findfile (strcat bn ".dwg")))
(progn
(setq cm (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.-insert" bd nil)
(setvar 'cmdecho cm)
(tblsearch "block" bn)
)
)
)
)
(princ (strcat "\nBlock \"" bn "\" not found."))
)
( (progn
(while
(progn
(setvar 'errno 0) (setq en (car (entsel "\nSelect object to measure: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type en))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list en)))
(princ "\nInvalid object selected.")
)
)
)
)
)
(/= 'ename (type en))
)
)
( (progn
(initget 6)
(setq di (getdist "\nSpecify length of segment: "))
)
(setq p1 (vlax-curve-getstartpoint en)
p2 (vlax-curve-getendpoint en)
x1 (abs (- (car p2) (car p1)))
sn (fix (/ x1 di))
x1 (+ (min (car p1) (car p2)) (/ (- x1 (* di sn)) 2.0))
ob (vlax-ename->vla-object en)
sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(repeat (1+ sn)
(setq ln (vlax-invoke sp 'addline (list x1 0.0 0.0) (list x1 1.0 0.0)))
(if (setq in (vlax-invoke ob 'intersectwith ln acextendotherentity))
(vlax-invoke sp 'insertblock (mapcar '+ in '(0.0 0.0 0.0)) bn 1.0 1.0 1.0 0.0)
)
(vla-delete ln)
(setq x1 (+ x1 di))
)
)
)
(princ)
)
(vl-load-com) (princ)
“李麦克”！。。。它工作得很好！。。。谢谢！！！。。。 我在代码中添加了一个小问题以获得块名：
(defun c:mymeasure ( / *error* bd bn cm di en in ln ob p1 p2 sn sp x1 )
;(setq bn "Botão") ; Name of block to insert ("myblock")
(setq bn (getstring "\nEnter with block Name: "))
(defun *error* ( msg )
(if (and (= 'vla-object (type ln)) (not (vlax-erased-p ln)))
(vl-catch-all-apply 'vla-delete (list ln))
)
(if (= 'int (type cm))
(setvar 'cmdecho cm)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nCurrent layer locked.")
)
( (not
(or (tblsearch "block" bn)
(and (setq bd (findfile (strcat bn ".dwg")))
(progn
(setq cm (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.-insert" bd nil)
(setvar 'cmdecho cm)
(tblsearch "block" bn)
)
)
)
)
(princ (strcat "\nBlock \"" bn "\" not found."))
)
( (progn
(while
(progn
(setvar 'errno 0) (setq en (car (entsel "\nSelect object to measure: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type en))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list en)))
(princ "\nInvalid object selected.")
)
)
)
)
)
(/= 'ename (type en))
)
)
( (progn
(initget 6)
(setq di (getdist "\nSpecify length of segment: "))
)
(setq p1 (vlax-curve-getstartpoint en)
p2 (vlax-curve-getendpoint en)
x1 (abs (- (car p2) (car p1)))
sn (fix (/ x1 di))
x1 (+ (min (car p1) (car p2)) (/ (- x1 (* di sn)) 2.0))
ob (vlax-ename->vla-object en)
sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(repeat (1+ sn)
(setq ln (vlax-invoke sp 'addline (list x1 0.0 0.0) (list x1 1.0 0.0)))
(if (setq in (vlax-invoke ob 'intersectwith ln acextendotherentity))
(vlax-invoke sp 'insertblock (mapcar '+ in '(0.0 0.0 0.0)) bn 1.0 1.0 1.0 0.0)
)
(vla-delete ln)
(setq x1 (+ x1 di))
)
)
)
(princ)
)
(vl-load-com) (princ) 不客气！
页:
[1]