mdist lisp
你好在测量时，我遇到了一个将osnapz固定为1的问题。
此外，我需要一个错误处理，以确保在程序中断或退出后再次将osnapz设置为1。
解释：
我将osnapz设置为1，以避免测量三维点，从而在从二维视图测量时破坏我的结果。
(defun c:mdist (/ )
(setvar "osnapz" 1)
(command "_dist" PAUSE "p")
(setvar "osnapz" 0)
)
这段代码将在我进行测量时将Var osnapz设置为0，所以这不好；（如何保持测量，并在lisp结束时将VAR osnapz设置为0（或在处理错误时，中断退出…）？
我知道还有其他lisp，但我喜欢在测量时使用默认的dist命令来查看直线。
谢谢你的帮助。 我建议这样做（如果您想在例程开始之前将osnapz设置为0，这样您可以确保在中断或终止时，osnapz将返回0；否则，如果已经设置为1，则将保留1，并在终止后保留）。。。
(defun c:mdist ( / *error* osz )
(defun *error* ( m )
(if osz
(setvar 'osnapz osz)
)
(if m
(prompt m)
)
(princ)
)
(setq osz (getvar 'osnapz))
(setvar 'osnapz 1)
(command "_.DIST" "\\" "_P")
(*error* nil)
)
谢谢你的回复。
启动代码时，您的代码确实会将osnapz激活为1（这就是我想要的）。
但当我点击第一个测量点时，osnapz返回到0；(
但至少感谢您对错误的处理。
（顺便提一下，我从代码中删除了下划线bebore the P。在法语中，它用于多个） 这是：
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/reactors-with-lwpolyline/m-p/4315713/highlight/true#M312846
我个人使用单距离检查，但精度很高。。。
(defun c:dii ( / p1 p2 d dx dy dz v dxw dyw dzw w ax vprim vprimd axy )
(while (not p1) (setq p1 (getpoint "\nPick or specify start point : ")))
(while (not p2) (setq p2 (getpoint p1 "\nPick or specify end point : ")))
(setq d (distance p1 p2))
(setq dx (car (setq v (mapcar '- p2 p1))))
(setq dy (cadr v))
(setq dz (caddr v))
(setq dxw (car (setq w (mapcar '- (trans p2 1 0) (trans p1 1 0)))))
(setq dyw (cadr w))
(setq dzw (caddr w))
(setq ax (cvunit (atan dy dx) "radians" "degrees"))
(setq vprim (list (car v) (cadr v) 0.0))
(setq vprimd (distance '(0.0 0.0 0.0) vprim))
(setq axy (cvunit (atan (caddr v) vprimd) "radians" "degrees"))
(prompt "\nDistance : ")(princ (rtos d 2 50))
(prompt "\n\nDX in UCS : ")(princ (rtos dx 2 50))
(prompt "\nDY in UCS : ")(princ (rtos dy 2 50))
(prompt "\nDZ in UCS : ")(princ (rtos dz 2 50))
(prompt "\n\nDX in WCS : ")(princ (rtos dxw 2 50))
(prompt "\nDY in WCS : ")(princ (rtos dyw 2 50))
(prompt "\nDZ in WCS : ")(princ (rtos dzw 2 50))
(prompt "\n\nAngle around Z axis from X axis as 0.0 degree reference : ")(princ (rtos ax 2 50))(prompt " degrees")
(prompt "\nAngle of picked points vector to XY plane : ")(princ (rtos axy 2 50))(prompt " degrees")
(princ)
)
HTH，M.R。 请尝试以下操作：
(defun c:mdist ( / *error* osz pnt )
(defun *error* ( msg )
(if osz (setvar 'osnapz osz))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if (setq osz (getvar 'osnapz))
(setvar 'osnapz 1)
)
(if (setq pnt (getpoint "\nSpecify first point: "))
(progn
(command "_.dist" "_non" pnt "_m")
(while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\"))
)
)
(if osz (setvar 'osnapz osz))
(princ)
) 你为什么不一起摆脱命令调用呢？
(defun c:mdist ( / totaldist pnt1 nextpoint)
(setq totaldist 0)
(if (and (setq pnt1 (getpoint "\nSpecify first point: "))
(setq pnt1 (reverse (cdr (reverse pnt1)))))
(while (setq nextpoint (getpoint pnt1 "\nSpecify next point: "))
(setq totaldist (+ totaldist (distance pnt1 (setq pnt1 (reverse (cdr (reverse nextpoint))))))))
)
(if (< 0 totaldist)
(princ (strcat "\nDistance = " (rtos totaldist))))
(princ)
) 我应该学会阅读。你喜欢这条线。苏。。。。
(defun c:mdist ( / totaldist pnt1 nextpoint)
(defun totaldist (distlist / )
(if (> (length distlist) 1)
(+ (distance (car distlist) (cadr distlist)) (totaldist (cdr distlist)))
0)
)
(defun grdrawlist (pointlist1 / )
(if (> (length pointlist1) 1)
(append (list 1 (car pointlist1) (cadr pointlist1)) (grdrawlist (cdr pointlist1)))))
(if (and (setq pnt1 (getpoint "\nSpecify first point: "))
(setq pnt1 (reverse (cdr (reverse pnt1))))
(setq pointlist (list pnt1)))
(while (setq nextpoint (getpoint (car (reverse pointlist)) "\nSpecify next point: "))
(setq pointlist (append pointlist (list (reverse (cdr (reverse nextpoint))))))
(redraw)
(grvecs (grdrawlist pointlist))
))
(if (< 0 (setq totaldist (totaldist pointlist)))
(princ (strcat "\nDistance = " (rtos totaldist))))
(redraw)
(princ)
) 谢谢你，李，一如既往
事实上，如果osnapz已经为1（在启动代码之前），那么在完成或退出时它将保持该值（我希望在命令结束时将其恢复为0）。但它已经很棒了。谢谢
Commandobill，谢谢你，但我更愿意留在dist command。 不错的代码；-）
就我个人而言，我喜欢一个马尔科里巴使用。
为了我自己的需要对它进行了进一步的调整。
当然需要画一条线。。
干杯，汉斯
(defun c:dii ( / x1 y1 z1 x2 y2 z2 p1 p2 d ducs dx dy dz v dxw dyw dzw w ax vprim vprimd axy )
(while (not p1) (setq p1 (getpoint "\nPick or specify start point : ")))
(while (not p2) (setq p2 (getpoint p1 "\nPick or specify end point : ")))
(setq d (distance p1 p2))
(grdraw p1 p2 6 1) ; halam
(setq dx (car (setq v (mapcar '- p2 p1))))
(setq dy (cadr v))
(setq ducs (sqrt (+ (* dx dx) (* dy dy)))) ; halam
(setq dz (caddr v))
(setq dxw (car (setq w (mapcar '- (trans p2 1 0) (trans p1 1 0)))))
(setq dyw (cadr w))
(setq dzw (caddr w))
(setq ax (cvunit (atan dy dx) "radians" "degrees"))
(setq vprim (list (car v) (cadr v) 0.0))
(setq vprimd (distance '(0.0 0.0 0.0) vprim))
(setq axy (cvunit (atan (caddr v) vprimd) "radians" "degrees"))
(prompt "\nDistance WCS : ")(princ (rtos d 2 50))
(prompt "\nDistance UCS : ")(princ (rtos ducs 2 50))
(prompt "\n\nDX in UCS : ")(princ (rtos dx 2 50))
(prompt "\nDY in UCS : ")(princ (rtos dy 2 50))
(prompt "\nDZ in UCS : ")(princ (rtos dz 2 50))
(prompt "\n\nDX in WCS : ")(princ (rtos dxw 2 50))
(prompt "\nDY in WCS : ")(princ (rtos dyw 2 50))
(prompt "\nDZ in WCS : ")(princ (rtos dzw 2 50))
(prompt "\n\nAngle around Z axis from X axis as 0.0 degree reference : ")(princ (rtos ax 2 50))(prompt " degrees")
(prompt "\nAngle of picked points vector to XY plane : ")(princ (rtos axy 2 50))(prompt " degrees")
(setq x1(car p1) ; halam
y1(cadr p1) ; halam
z1(caddr p1)); halam
(setq x2(car p2) ; halam
y2(cadr p2) ; halam
z2(caddr p2)); halam
(setq stringid1 (strcat "\nID pt1 : "(rtos x1 2 3) "," (rtos y1 2 3) "," (rtos z1 2 3))) ; halam
(setq stringid2 (strcat "\nID pt2 : "(rtos x2 2 3) "," (rtos y2 2 3) "," (rtos z2 2 3))) ; halam
(setq string1 (strcat "\n\nDistance UCS : " (rtos ducs 2 3)))
(setq string2 (strcat "\nDX in UCS : " (rtos dx 2 3)))
(setq string3 (strcat "\nDY in UCS : " (rtos dy 2 3)))
(setq string4 (strcat "\nDZ in UCS : " (rtos dz 2 3)))
(setq string5 (strcat "\nAngle in UCS plane : " (rtos axy 2 3) " degrees"))
(setq string6 (strcat "\n"))
(setq string7 (strcat "\nDistance WCS : " (rtos d 2 3)))
(setq string8 (strcat "\nDX in WCS : " (rtos dxw 2 3)))
(setq string9 (strcat "\nDY in WCS : " (rtos dyw 2 3)))
(setq string10 (strcat "\nDZ in WCS : " (rtos dzw 2 3)))
(setq string11 (strcat "\nAngle around Z axis as plane : " (rtos ax 2 3)" degrees"))
(setq alertstring (strcat stringid1 stringid2 string1 string2 string3 string4 string5 string6 string7 string8 string9 string10 string11))
(alert alertstring)
(princ))
(defun C:D()(c:dii)) ;halam
我想我会扔掉我的一个旧的，关于方位、距离、三角洲海拔和坡度：
;| By Tom Beauford:
Dst.lsp will prompt the user to pick the first point, then pick the next point,
then display the distance picked by with a colored line, every distance measured
shows a different color. the bearing & horizontal distance will be displayed in
the left corner of the status line and the bearing, horizontal distance, difference
in elevation and slope will be displayed on the command line.
Macro: ^P(or C:DST (load "DST.lsp"));DST
Command line: (load "DST.lsp") DST
|;
(defun C:DST ( / *ERROR* 2DIST fact str1 tw CNTR PT1 PT2 ang DST PDST Pang)
(defun *ERROR* (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(grtext -1 "") ; Clear status line.
(vl-cmdf "redraw")
(princ)
)
(defun 2DIST (PT)
(list (car pt)(cadr pt))
) ;defun
(setq fact nil)
(if(and(= 1 (getvar "cvport"))(trans '(1 0 0) 2 3 0))
(progn
(setq fact (car (trans '(1 0 0) 2 3 0)))
(princ "\nPS:MS == 1:")
(princ(/ 1 fact))
(setvar "NOMUTT" 1)
(command "mspace")
(setq tw (- (* 2 pi)(cdr(assoc 51(entget(acet-currentviewport-ename))))))
(command "pspace")
(setvar "NOMUTT" 0)
)
)
(setq CNTR 0 ;INITIALIZE COUNTER
PT1 (getpoint "\nPick First Point") ;PROMPT FOR FIRST POINT
PT2 PT1
)
(while PT2 ;IF YES OR ENTER
(setq PT2 (getpoint "\nPick Next Point" PT1)) ;PROMPT FOR NEXT POINT
(if PT2
(progn
(if fact
(progn
(setq DST (/ (distance (2DIST PT1)(2DIST PT2))fact) ;CONVERT TO STRING
PDST (distance (2DIST PT1)(2DIST PT2)) ;CONVERT TO STRING
CNTR (1+ CNTR) ;ADD TO COUNTER FOR COLOR CHANGE
Pang (angtos (angle pt1 pt2)4 4)
ang (angtos (+(angle pt1 pt2)tw)4 4)
deltaz(/ (- (car(cddr pt2)) (car(cddr pt1)))fact)
slope (/ deltaz DST)
)
(if(eq Pang ang)
(setq DST(strcat "MS Bearing= "ang ", Dist= " (rtos DST 2 2) "', PS Dist= " (rtos PDST 2 2) "\""))
(setq DST(strcat "MS Bearing= "ang ", Dist= " (rtos DST 2 2) "', PS Bearing= "Pang ", Dist= " (rtos PDST 2 2) "\""))
);if
);progn
(setq DST (distance (2DIST PT1)(2DIST PT2))
CNTR (1+ CNTR)
ang (angtos (angle pt1 pt2)4 4)
deltaz(- (car(cddr pt2)) (car(cddr pt1)))
slope (/ deltaz DST)
DST (strcat "Bearing= "ang ", Dist= " (rtos DST 2 2) "'")
)
);if fact
(if (/= 0 deltaz)
(progn
(cond
((equal (abs slope) (/ 1.0 2) 0.0001)(setq slope "2:1"))
((equal (abs slope) (/ 1.0 3) 0.0001)(setq slope "3:1"))
((equal (abs slope) (/ 1.0 4) 0.0001)(setq slope "4:1"))
((equal (abs slope) (/ 1.0 5) 0.0001)(setq slope "5:1"))
((equal (abs slope) (/ 1.0 6) 0.0001)(setq slope "6:1"))
((equal (abs slope) (/ 1.0 7) 0.0001)(setq slope "7:1"))
((equal (abs slope) (/ 1.00.0001)(setq slope "8:1"))
((equal (abs slope) (/ 1.0 9) 0.0001)(setq slope "9:1"))
((equal (abs slope) (/ 1.0 10) 0.0001)(setq slope "10:1"))
((equal (abs slope) (/ 1.0 12) 0.0001)(setq slope "12:1"))
((equal (abs slope) (/ 1.0 15) 0.0001)(setq slope "15:1"))
((equal (abs slope) (/ 1.0 20) 0.0001)(setq slope "20:1"))
((equal (abs slope) (/ 1.0 30) 0.0001)(setq slope "30:1"))
((equal (abs slope) (/ 1.0 40) 0.0001)(setq slope "40:1"))
((equal (abs slope) (/ 1.0 50) 0.0001)(setq slope "50:1"))
((equal (abs slope) (/ 1.0 100) 0.0001)(setq slope "100:1"))
; ((equal (abs slope) (/ 0.25 12) 0.0001)(setq slope "1/4\"=1'"))
(T(setq slope (strcat (rtos (* slope 100) 2 4) "%")))
)
(setq DST (strcat DST "Delta elev= "(rtos deltaz) "Slope= " slope))
);progn
);if
(prompt (strcat "\n" DST)) ;Print the distance to command line
(grtext -1 DST) ;Print distance in status line
(grdraw PT1 PT2 CNTR 2) ;Draw a colored line between points
(setq PT1 PT2) ;Change start point
) ;end progn
) ;end if PT2
) ;end while PT2
(grtext -1 "") ;Clear status line
(vl-cmdf "redraw")
(princ)
) ;end fun
页:
[1]
2