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

byghbcx

先定义一个块，再用MEASURE命令.lsp也可以做，但计算要复杂点，对多义线，首先要求出每隔１．５米的所有点，然后分别求出该点的法线角度，也就可以达到目的要求了．

lht

(defun c:kjh ( / )
(setvar "osmode" 0)                           ;关闭捕捉
(command"_pline" (list 0 0) (list 100 0) "")  ;画长为１００的水平线
(command"_pline" (list 0 0) (list 0 0.5) "")  ;画长为０．５的垂直线
(command "-array" (entlast) "" "r" 1 101 1 "");１行，１０１列，列距为１的矩阵
(setvar "osmode" 35)                          ;打开捕捉
)

lht

(defun c:kjh ( / )
(setvar "osmode" 0)                           ;关闭捕捉
(command"_pline" (list 0 0) (list 100 0) "")  ;画长为１００的水平线
(command"_pline" (list 0 0) (list 0 0.5) "")  ;画长为０．５的垂直线
(command "-array" (entlast) "" "r" 1 101 1 "");１行，１０１列，列距为１的矩阵
(setvar "osmode" 35)                          ;打开捕捉
)

byghbcx

多义线只是水平的吗？只有一段吗？这有点太简单了

wei209

"-array" 改为 "_array"

alin

;;; ***************
;;; By Alvin Y. LIN
;;; ***************
(defun C:test (/   interval   width initlen    oldOSMODE
        plObj   ent      startPoint endPoint   initPoint
        revp   len      interval num    cnt
        rotang   firstDeriv pt  stPoint    selPoint
       )
  (setq interval 1000   ; 1m
 width 500   ; 0.5m
 initlen 0   ;????
  )
  (setq oldOSMODE (getvar "OSMODE"))
  (command "ucs" "w")
  (setq plObj (vlax-ename->vla-object
  (car
    (setq ent (entsel "\nSelect an object: "))
  )
       )
  )
  (if (member (vla-get-objectname plObj)
       '("AcDbPolyline"   "AcDbLine"     "AcDbSpline"
  "AcDbARC"   "AcDbCircle"     "AcDbEllipse"
        )
      )
    (progn
      (setq selPoint (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))))
      (setq cnt 0)
      (command "undo" "BE")
      (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
      (command "undo" "E")
    )     ;progn
    (alert "\Invalid object Selected!")
  )     ;endif
  (vlax-release-object plObj)
  (command "ucs" "p")
  (setvar "OSMODE" oldOSMODE)
  (princ)
)

byghbcx

可以改一下,即画即显示,加入比例变量,但怎样在多义线绘制中间能够绘制短线,就是说在命令行显示为:

指定下一点或 [圆弧(A)/闭合(C)/半宽(H)/长度(L)/放弃(U)/宽度(W)]:

的时候能运行程序.

我一时还没想到办法(可以用程序去模拟多义线绘制命令,但这样较复杂点),是否注册一个透明命令?

(defun C:test (/ scale  interval   width initlen    oldOSMODE
        plObj   ent  pt1 pt2    startPoint endPoint   initPoint
        revp   len      interval num    cnt
        rotang   firstDeriv pt  stPoint    selPoint
       )
  (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输入多义线起点"))
  (setq pt2 (getpoint pt1 "\n输入多义线顶点(下一点)"))
  (while pt2
    (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)
    (setq pt2 (getpoint pt1 "\n输入多义线顶点(下一点)"))
    )
  (vlax-release-object plObj)
  (command "ucs" "p")
  (command "undo" "E")
  (setvar "OSMODE" oldOSMODE)
  (princ)
)

77077

楼上的，我运行了以后发现是以下这个样子哦！

在转弯的地方就不能在多段线上了！

byghbcx

这里没有多段线模拟程序,也就是没有加入弧段的功能,要稍加修改方能实现

77077

问题是 难者不会，会者不难！

请楼上的帮忙一下哦！