画一条多义线每隔1米加一个0.5米的横短线怎么实现啊?

byghbcx

看看这样可以了吧

2. (defun C:test (/ scale  interval   width initlen    oldOSMODE
3.         plObj   ent  pt1 pt2  ang  startPoint endPoint   initPoint
4.         revp   len      interval num    cnt
5.         rotang   firstDeriv pt  stPoint    selPoint
6.        );画一条多义线每隔1米加一个0.5米的横短线
7.   (setq scale (getreal "\n请输入比例1:<1000>"))
8.   (if (not scale) (setq scale 1000))
9.   (setq interval scale   ; 1m
10. width (* scale 0.5)  ; 0.5m
11. initlen 0   ;????
12.   )
13.   (setq oldOSMODE (getvar "OSMODE"))
14.   (setq cnt 0)
15.   (command "undo" "BE")
16.   (command "ucs" "w")
17.   (vl-load-com)
18.   (setq pt1 (getpoint "\n输入多义线起点"))
19.   (initget "a A")
20.   (setq pt2 (getpoint pt1 "\n输入多义线顶点[A/(弧)](下一点)"))
21.   (while pt2
22.     (if (and (= (type pt2) 'str) (= (strcase pt2) "A"))
23.       (progn
24. (if ent
25.    (progn
26.       (setq firstDeriv  (vlax-curve-getFirstDeriv  ent (vlax-curve-getendparam ent)))
27.              (setq ang (angle '(0 0 0) firstDeriv))
28.       (setq ang (* (/ ang pi) 180.0))
29.      )
30.    (setq ang 0)
31.    )
32. (command "_.pline" pt1 "a" "d" ang pause  "")
33. (setq pt2 (getvar 'lastpoint))
34. )
35.     (command "_.pline" pt1 pt2 "")
36.       )
37.     (if ent (progn (command "_.pedit" ent "j" (entlast) "" ""))) (setq ent (entlast))
38.   (setq plObj (vlax-ename->vla-object ent
39. ;;;  (car
40. ;;;    (setq ent (entsel "\nSelect an object: "))
41. ;;;  )
42.        )
43.   )
44.   (if (member (vla-get-objectname plObj)
45.        '("AcDbPolyline" "AcDb2dPolyline"  "AcDbLine"     "AcDbSpline"
46.   "AcDbARC"   "AcDbCircle"     "AcDbEllipse"
47.         )
48.       )
49.     (progn
50. ;;;      (setq selPoint (cdr (assoc 10 (entget ent)))));(cadr ent))
51.       (setq startPoint (vlax-curve-getStartPoint plObj))
52.       (setq endPoint (vlax-curve-getEndPoint plObj))
53. ;;;      (if (> (distance selPoint startPoint)
54. ;;;      (distance selPoint endPoint)
55. ;;;   )
56. ;;; (setq stPoint endPoint
57. ;;;       revp    T
58. ;;; )
59. (setq stPoint startPoint
60.        revp    nil
61. )
62. ;;;      )
63.       (setvar "OSMODE" 0)
64.       (setq len (- (vlax-curve-getDistAtParam
65.        plObj
66.        (vlax-curve-getendparam plObj)
67.      )
68.      initlen
69.   )
70.       )
71.       (setq num (1+ (fix (/ len interval))))
72.       
73.       (while (<= cnt (1- num))
74. (cond ((= revp nil)
75.         (setq pt (vlax-curve-getPointAtDist
76.      plObj
77.      (+ initlen (* interval cnt))
78.    )
79.         )
80.         (setq firstDeriv
81.         (vlax-curve-getFirstDeriv
82.    plObj
83.    (vlax-curve-getParamAtPoint plObj pt)
84.         )
85.         )
86.         (setq rotang (angle '(0 0 0) firstDeriv))
87.         (command "line"
88.    (polar pt (+ rotang (* 0.5 pi)) (* 0.5 width))
89.    (polar pt (- rotang (* 0.5 pi)) (* 0.5 width))
90.    ""
91.         )
92.        )
93.        ((= revp T)
94.         (setq pt (vlax-curve-getPointAtDist
95.      plObj
96.      (- len (* interval cnt))
97.    )
98.         )
99.         (setq firstDeriv
100.         (vlax-curve-getFirstDeriv
101.    plObj
102.    (vlax-curve-getParamAtPoint plObj pt)
103.         )
104.         )
105.         (setq rotang (angle '(0 0 0) firstDeriv))
106.         (command "line"
107.    (polar pt (+ rotang (* 0.5 pi)) (* 0.5 width))
108.    (polar pt (- rotang (* 0.5 pi)) (* 0.5 width))
109.    ""
110.         )
111.        )
112. )    ;cond
113. (setq cnt (1+ cnt))
114.       )     ;while
115.       
116.     )     ;progn
117.     (alert "\Invalid object Selected!")
118.   )     ;endif
119.     (setq pt1 pt2)
120.     (initget "a A")
121.     (setq pt2 (getpoint pt1 "\n输入多义线顶点[A/(弧线)](下一点)"))
122.     )
123.   (vlax-release-object plObj)
124.   (command "ucs" "p")
125.   (command "undo" "E")
126.   (setvar "OSMODE" oldOSMODE)
127.   (princ)
128. )

(defun C:test (/ scale  interval   width initlen    oldOSMODE         plObj   ent  pt1 pt2  ang  startPoint endPoint   initPoint         revp   len      interval num    cnt         rotang   firstDeriv pt  stPoint    selPoint        );画一条多义线每隔1米加一个0.5米的横短线   (setq scale (getreal "\n请输入比例1:<1000>"))   (if (not scale) (setq scale 1000))   (setq interval scale   ; 1m width (* scale 0.5)  ; 0.5m initlen 0   ;????   )   (setq oldOSMODE (getvar "OSMODE"))   (setq cnt 0)   (command "undo" "BE")   (command "ucs" "w")   (vl-load-com)   (setq pt1 (getpoint "\n输入多义线起点"))   (initget "a A")   (setq pt2 (getpoint pt1 "\n输入多义线顶点[A/(弧)](下一点)"))   (while pt2     (if (and (= (type pt2) 'str) (= (strcase pt2) "A"))       (progn (if ent    (progn       (setq firstDeriv  (vlax-curve-getFirstDeriv  ent (vlax-curve-getendparam ent)))              (setq ang (angle '(0 0 0) firstDeriv))       (setq ang (* (/ ang pi) 180.0))      )    (setq ang 0)    ) (command "_.pline" pt1 "a" "d" ang pause  "") (setq pt2 (getvar 'lastpoint)) )     (command "_.pline" pt1 pt2 "")       )     (if ent (progn (command "_.pedit" ent "j" (entlast) "" ""))) (setq ent (entlast))   (setq plObj (vlax-ename->vla-object ent ;;;  (car ;;;    (setq ent (entsel "\nSelect an object: ")) ;;;  )        )   )   (if (member (vla-get-objectname plObj)        '("AcDbPolyline" "AcDb2dPolyline"  "AcDbLine"     "AcDbSpline"   "AcDbARC"   "AcDbCircle"     "AcDbEllipse"         )       )     (progn ;;;      (setq selPoint (cdr (assoc 10 (entget ent)))));(cadr ent))       (setq startPoint (vlax-curve-getStartPoint plObj))       (setq endPoint (vlax-curve-getEndPoint plObj)) ;;;      (if (> (distance selPoint startPoint) ;;;      (distance selPoint endPoint) ;;;   ) ;;; (setq stPoint endPoint ;;;       revp    T ;;; ) (setq stPoint startPoint        revp    nil ) ;;;      )       (setvar "OSMODE" 0)       (setq len (- (vlax-curve-getDistAtParam        plObj        (vlax-curve-getendparam plObj)      )      initlen   )       )       (setq num (1+ (fix (/ len interval))))              (while (<= cnt (1- num)) (cond ((= revp nil)         (setq pt (vlax-curve-getPointAtDist      plObj      (+ initlen (* interval cnt))    )         )         (setq firstDeriv         (vlax-curve-getFirstDeriv    plObj    (vlax-curve-getParamAtPoint plObj pt)         )         )         (setq rotang (angle '(0 0 0) firstDeriv))         (command "line"    (polar pt (+ rotang (* 0.5 pi)) (* 0.5 width))    (polar pt (- rotang (* 0.5 pi)) (* 0.5 width))    ""         )        )        ((= revp T)         (setq pt (vlax-curve-getPointAtDist      plObj      (- len (* interval cnt))    )         )         (setq firstDeriv         (vlax-curve-getFirstDeriv    plObj    (vlax-curve-getParamAtPoint plObj pt)         )         )         (setq rotang (angle '(0 0 0) firstDeriv))         (command "line"    (polar pt (+ rotang (* 0.5 pi)) (* 0.5 width))    (polar pt (- rotang (* 0.5 pi)) (* 0.5 width))    ""         )        ) )    ;cond (setq cnt (1+ cnt))       )     ;while            )     ;progn     (alert "\Invalid object Selected!")   )     ;endif     (setq pt1 pt2)     (initget "a A")     (setq pt2 (getpoint pt1 "\n输入多义线顶点[A/(弧线)](下一点)"))     )   (vlax-release-object plObj)   (command "ucs" "p")   (command "undo" "E")   (setvar "OSMODE" oldOSMODE)   (princ) )

xyp1964

;;;画一条多义线每隔1米加一个0.5米的横短线
(defun c:test ()
  (CMDLA0)
  (setq ss (ssget '((0 . "*POLYLINE")))
 i  -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq ptn (xyp-get-CurveDivPtlst s1 1))
    (foreach pt ptn
      (xyp-Faxian s1 pt 0.5)
    )
  )
  (CMDLA1)
)

xyf0405

用ACAC自带的命令就行了，R14版都有这个命令：定距等分

把短横线做一个块：qwe,后面的看动画：

mycad

用measure或divide命令，可以使用lisp调用这两个命令．

sotop

我也想知道，同求