byghbcx 发表于 2007-4-28 15:33:00

看看这样可以了吧
(defun C:test (/ scaleinterval   width initlen    oldOSMODE
      plObj   entpt1 pt2angstartPoint endPoint   initPoint
      revp   len      interval num    cnt
      rotang   firstDeriv ptstPoint    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输入多义线顶点(下一点)"))
(while pt2
    (if (and (= (type pt2) 'str) (= (strcase pt2) "A"))
      (progn
(if ent
   (progn
      (setq firstDeriv(vlax-curve-getFirstDerivent (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输入多义线顶点(下一点)"))
    )
(vlax-release-object plObj)
(command "ucs" "p")
(command "undo" "E")
(setvar "OSMODE" oldOSMODE)
(princ)
)

xyp1964 发表于 2007-4-29 14:04:00

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

xyf0405 发表于 2007-4-30 10:51:00

<p>用ACAC自带的命令就行了，R14版都有这个命令：定距等分</p><p>把短横线做一个块：qwe,后面的看动画：</p>

mycad 发表于 2007-5-5 09:29:00

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

sotop 发表于 2013-4-23 17:07:02

我也想知道，同求
页: 1 2 [3]
查看完整版本: 画一条多义线每隔1米加一个0.5米的横短线怎么实现啊?