我在第12、13和14版中工作，它们大多没有activeX功能。我只将Acad 2000用于大型渲染项目。
在以后的AutoCAD版本中，我从未发现任何“我离不开”的东西
李，
我使用样板模板来实现真正的程序。我做了基本的弧线测试。我在飞行中写的主体-大卫 好的，我快速试用了ASMI的版本，它已经加快了当前的进程。然而，如果我可以通过某种选择过滤器（名称、图层最好）以某种方式选择许多块，然后将结果值列在表中，这将是一个很好的改进。如果这张表还可以有另一列，向我们展示关于块的独特之处，比如它的坐标或特定属性，我会很高兴。 我还有一个问题，一开始我忘了提，那就是图纸上的轨道和公路，代表它们的多段线，通常是3D的；然而，在这种情况下，我们希望将其视为2D，忽略Z值，因为这会扭曲真实距离。
再次感谢。 这是一个初学者：
将返回块基点和到直线的距离的列表。
; pdis by ASMI, (modified by Lee Mac)
(defun c:pdis (/ cCurve cBlock index ent dPt1 dPt2 blkDist blklist)
(vl-load-com)
(if
(and
(setq cCurve (entsel "\nSelect curve to measure > "))
(member (cdr (assoc 0 (entget (car cCurve))))
'("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")
) ;_end member
) ; end and
(progn
(setq cBlock (ssget '((0 . "INSERT")))
index(1- (sslength cBlock))
) ;_end setq
(while (not (minusp index))
(setq ent(entget (ssname cBlock index))
dPt1 (cdr (assoc 10 ent))
dPt2 (vlax-curve-getClosestPointTo (car cCurve) dPt1)
blkDist (distance dPt1 dPt2)
) ;_end setq
(setq blklist (cons (list dPt1 blkDist) blklist)
index (1- index)
) ;_end setq
) ; end while
) ;_end progn
(princ "\n<!> Empty selection or this isn't curve (line, polyline, etc.) <!> ")
) ; end if
(alert (vl-princ-to-string blklist))
(princ)
) ; end of c:pdis
稍微好一点：
(defun c:pdis (/ cCurve cBlock index ent dPt1 dPt2 blkDist blklist)
(vl-load-com)
(if
(and
(setq cCurve (entsel "\nSelect curve to measure > "))
(member (cdr (assoc 0 (entget (car cCurve))))
'("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")
) ;_end member
) ; end and
(progn
(setq cBlock(ssget '((0 . "INSERT")))
index (1- (sslength cBlock))
blklist "\n"
) ;_end setq
(while (not (minusp index))
(setq ent (entget (ssname cBlock index))
dPt1 (cdr (assoc 10 ent))
dPt2 (vlax-curve-getClosestPointTo (car cCurve) dPt1)
blkDist (distance dPt1 dPt2)
) ;_end setq
(setq blklist (strcat "\n"
(rtos (car dPt1))
","
(rtos (cadr dPt1))
" <---> "
(rtos blkDist)
blklist
) ;_end strcat
index (1- index)
) ;_end setq
) ; end while
) ;_end progn
(princ "\n<!> Empty selection or this isn't curve (line, polyline, etc.) <!> ")
) ; end if
(alert blklist)
(princ)
) ; end of c:pdis
好的，这个怎么样：
(defun c:pdis (/ cCurve cBlock txtpnt index ent dPt1 dPt2 blkDist blklist txt)
(defun makelay (x)
(if (not (tblsearch "Layer" x))
(progn
(setvar "cmdecho" 0)
(command "-layer" "m" x "")
(setvar "cmdecho" 1)
) ;_end progn
(setvar "CLAYER" x)
) ;_end if
) ;_end defun
(defun Make_Text (txt_pt txt_val)
(entmake
(list '(0 . "TEXT")
'(8 . "TEXT")
(cons 10 txt_pt)
(cons 40 2.5)
(cons 1 txt_val)
'(50 . 0.0)
'(7 . "STANDARD")
'(71 . 0)
'(72 . 0)
'(73 . 0)
) ; end list
) ; end entmake
) ;_end defun
(vl-load-com)
(if
(and
(setq cCurve (entsel "\nSelect curve to measure > "))
(member (cdr (assoc 0 (entget (car cCurve))))
'("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")
) ;_end member
) ; end and
(progn
(while
(and
(setq cBlock (ssget '((0 . "INSERT"))))
(setq txtpnt (getpoint "\nSelect Point for Table > "))
) ;_end and
(makelay "TEXT")
(setq index (1- (sslength cBlock))
blklist "\n"
txt 1
) ;_end setq
(while (not (minusp index))
(setq ent (entget (ssname cBlock index))
dPt1 (cdr (assoc 10 ent))
dPt2 (vlax-curve-getClosestPointTo (car cCurve) dPt1)
blkDist (distance dPt1 dPt2)
) ;_end setq
(setq blklist (strcat (rtos (car dPt1) 2 1)
","
(rtos (cadr dPt1) 2 1)
" <---> "
(rtos blkDist 2 1)
) ;_end strcat
) ;_end setq
(Make_Text (polar txtpnt (* pi 1.5) (* 3.5 txt)) blklist)
(setq index (1- index)
txt (1+ txt)
) ;_end setq
) ; end while
) ;_end while
) ;_end progn
(princ "\n<!> Empty selection or this isn't curve (line, polyline, etc.) <!> ")
) ; end if
(princ)
) ;_end defun
对不起，所有的帖子！
还有一个更新：
(defun c:pdis (/ oldlay cCurve cBlock txtpnt index ent dPt1 dPt2 blkDist blklist txt)
(defun makelay (x)
(if (not (tblsearch "Layer" x))
(progn
(setvar "cmdecho" 0)
(command "-layer" "m" x "")
(setvar "cmdecho" 1)
) ;_end progn
(setvar "CLAYER" x)
) ;_end if
) ;_end defun
(defun Make_Text (txt_pt txt_val)
(entmake
(list '(0 . "TEXT")
'(8 . "TEXT")
(cons 10 txt_pt)
(cons 40 2.5)
(cons 1 txt_val)
'(50 . 0.0)
'(7 . "STANDARD")
'(71 . 0)
'(72 . 0)
'(73 . 0)
) ; end list
) ; end entmake
) ;_end defun
(vl-load-com)
(setq oldlay (getvar "clayer"))
(if
(and
(setq cCurve (entsel "\nSelect curve to measure > "))
(member (cdr (assoc 0 (entget (car cCurve))))
'("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")
) ;_end member
) ; end and
(progn
(while
(and
(setq cBlock (ssget '((0 . "INSERT"))))
(setq txtpnt (getpoint "\nSelect Point for Table > "))
) ;_end and
(makelay "TEXT")
(setq index (1- (sslength cBlock))
blklist "\n"
txt 1
) ;_end setq
(while (not (minusp index))
(setq ent (entget (ssname cBlock index))
dPt1 (cdr (assoc 10 ent))
dPt2 (vlax-curve-getClosestPointTo (car cCurve) dPt1)
blkDist (distance dPt1 dPt2)
) ;_end setq
(setq blklist (strcat (rtos (car dPt1) 2 1)
","
(rtos (cadr dPt1) 2 1)
" <---> "
(rtos blkDist 2 1)
) ;_end strcat
) ;_end setq
(Make_Text (polar txtpnt (* pi 1.5) (* 3.5 txt)) blklist)
(setq index (1- index)
txt (1+ txt)
) ;_end setq
) ; end while
) ;_end while
) ;_end progn
(princ "\n<!> Empty selection or this isn't a Curve (line, polyline, etc.) <!> ")
) ; end if
(setvar "clayer" oldlay)
(princ)
) ;_end defun
干杯明天上班时我会试试的。 没问题，告诉我结果 哎呀！多大的新上市。好的，李，麦克。坐标、表格等都是很好的训练。
我明天去看，因为该睡觉了。
页:
1
[2]