有时错有时可以运行，神马问题？

邹锋 · 发表于 2012-7-22 08:22:33

(defun c:asd ()
(command "undo" "be")
(setvar 'cmdecho 0)
(setvar 'osmode 16383)
(setq en (car (entsel "\n选择多段线:")))
(setq p1 (getpoint "\n选择切入点: "))
(setq fx (getint "\n选择方向 ([1]顺时针,[2]逆时针) <1>: "))
(if (= nil fx)
(setq fx 1)
)
(WCMATCH (cdr (assoc 0 (entget en))) "*POLYLINE")
(progn
(yytm)
(if (/= fx fang)
(VxRevPline obj)
)
(setq pt (vlax-curve-getClosestPointTo
(vlax-ename->vla-object en)
p1
)
)
(abhk)
(gjus_ent)
(command "undo" "e")
(princ)
)
)
;;判断方向是否一致
(defun yytm ()
(setq plineObj (vlax-ename->vla-object en)
len (vla-get-length plineobj)
)
(setq offsetplineObj
(car (vlax-safearray->list
(vlax-variant-value
(vla-offset plineObj (/ len 10000))
)
)
)
)
(if (< (vla-get-area offsetplineobj)
(vla-get-area plineobj)
)
(setq fang 1)
(setq fang 2)
)
(vla-delete offsetplineObj)
)
;;;;方向转换
(defun VxRevPline (Obj / BlgLst ObjName PntLst SegCnt TmpLst Ubound)
(setq Obj (vlax-ename->vla-object en))
(setq ObjName (vlax-get Obj 'ObjectName)
TmpLst (vlax-get Obj 'Coordinates)
)
(if (eq ObjName "AcDbPolyline")
(repeat (/ (length TmpLst) 2)
(setq PntLst (cons (list (car TmpLst) (cadr TmpLst)) PntLst)
TmpLst (cddr TmpLst)
)
)
(repeat (/ (length TmpLst) 3)
(setq PntLst (cons (list (car TmpLst) (cadr TmpLst) (caddr TmpLst))
PntLst
)
TmpLst (cdddr TmpLst)
)
)
)
(vlax-put Obj 'Coordinates (apply 'append PntLst))
(if (not (eq ObjNme "AcDb3dPolyline"))
(progn
(setq Ubound (1- (length PntLst))
BlgLst (list (* (vla-GetBulge Obj Ubound) -1))
SegCnt 0
)
(repeat Ubound
(setq BlgLst (cons (* (vla-GetBulge Obj SegCnt) -1) BlgLst)
SegCnt (1+ SegCnt)
)
)
(setq SegCnt 0)
(foreach memb BlgLst
(vla-SetBulge Obj SegCnt memb)
(setq SegCnt (1+ SegCnt))
)
)
)
(vla-Update Obj)
Obj
)
;;;功能:多段线增加节点
(defun abhk ()
(sssetfirst nil (ssadd en))
(setq enden (entlast))
(command "_break"
en
(vlax-curve-getclosestpointto en pt)
pt
)
(setq ss (ssadd))
(while (setq enden (entnext enden))
(if (not (member (cdr (assoc 0 (entget enden)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(ssadd enden ss)
)
)
(VL-CATCH-ALL-APPLY 'vl-cmdf (list "pedit" en "j" ss "" ""))
(sssetfirst nil (ssadd en))
(sssetfirst nil nil)
)
;;;;;更新图元
(defun gjus_ent ()
(setq pt0 (list (car pt) (cadr pt)))
(setq pt2 (list (car p1) (cadr p1)))
(setq dat (entget en))
(setq ptfrst (cons 10 pt0))
(setq dat0 (reverse (member (assoc 39 dat) (reverse dat)))
dat1 (cdr (member (assoc 39 dat) dat))
dat9 (list (last dat1))
dat1 (reverse (cdr (reverse dat1)))
data (member ptfrst dat1)
datb (reverse (cdr (member ptfrst (reverse dat1))))
)
(setq data1 (LIST (cons 10 pt2))
ptend (list ptfrst)
data2 (LIST (cons 40 0.0) (cons 41 0.0) (cons 42 0.0))
)
(setq aa (append dat0 data1 data2 data datb ptend data2 dat9)) ;排序
(setq dat70 (cons 70 1) ;改为不封闭的
dat71 (cons 70 0)
aaa (subst dat71 dat70 aa)
)
(setq shu1 (assoc 90 aaa) ;加多两个端点
shu (cdr shu1)
shu2 (cons 90 (+ 2 shu))
aaaa (subst shu2 shu1 aaa)
)
(entmod aaaa)
(princ)
)

(defun c:asd () 
  (command "undo" "be") 
  (setvar 'cmdecho 0) 
  (setvar 'osmode 16383) 
  (setq en (car (entsel "\n选择多段线:"))) 
  (setq p1 (getpoint "\n选择切入点: ")) 
  (setq fx (getint "\n选择方向 ([1]顺时针,[2]逆时针) <1>: ")) 
  (if (= nil fx) 
    (setq fx 1) 
  ) 
  (WCMATCH (cdr (assoc 0 (entget en))) "*POLYLINE") 
  (progn 
    (yytm) 
    (if (/= fx fang) 
      (VxRevPline obj) 
    ) 
    (setq pt (vlax-curve-getClosestPointTo 
        (vlax-ename->vla-object en) 
        p1 
      ) 
    ) 
    (abhk) 
    (gjus_ent) 
    (command "undo" "e") 
    (princ) 
  ) 
) 
 
;;判断方向是否一致 
(defun yytm () 
  (setq plineObj (vlax-ename->vla-object en) 
 len  (vla-get-length plineobj) 
  ) 
  (setq offsetplineObj 
  (car (vlax-safearray->list 
  (vlax-variant-value 
    (vla-offset plineObj (/ len 10000)) 
  ) 
       ) 
  ) 
  ) 
  (if (< (vla-get-area offsetplineobj) 
  (vla-get-area plineobj) 
      ) 
    (setq fang 1) 
    (setq fang 2) 
  ) 
  (vla-delete offsetplineObj) 
) 
;;;;方向转换 
(defun VxRevPline (Obj / BlgLst ObjName PntLst SegCnt TmpLst Ubound) 
  (setq Obj (vlax-ename->vla-object en)) 
  (setq ObjName (vlax-get Obj 'ObjectName) 
 TmpLst (vlax-get Obj 'Coordinates) 
  ) 
  (if (eq ObjName "AcDbPolyline") 
    (repeat (/ (length TmpLst) 2) 
      (setq PntLst (cons (list (car TmpLst) (cadr TmpLst)) PntLst) 
     TmpLst (cddr TmpLst) 
      ) 
    ) 
    (repeat (/ (length TmpLst) 3) 
      (setq PntLst (cons (list (car TmpLst) (cadr TmpLst) (caddr TmpLst)) 
    PntLst 
     ) 
     TmpLst (cdddr TmpLst) 
      ) 
    ) 
  ) 
  (vlax-put Obj 'Coordinates (apply 'append PntLst)) 
  (if (not (eq ObjNme "AcDb3dPolyline")) 
    (progn 
      (setq Ubound (1- (length PntLst)) 
     BlgLst (list (* (vla-GetBulge Obj Ubound) -1)) 
     SegCnt 0 
      ) 
      (repeat Ubound 
 (setq BlgLst (cons (* (vla-GetBulge Obj SegCnt) -1) BlgLst) 
       SegCnt (1+ SegCnt) 
 ) 
      ) 
      (setq SegCnt 0) 
      (foreach memb BlgLst 
 (vla-SetBulge Obj SegCnt memb) 
 (setq SegCnt (1+ SegCnt)) 
      ) 
    ) 
  ) 
  (vla-Update Obj) 
  Obj 
) 
 
;;;功能:多段线增加节点 
(defun abhk () 
  (sssetfirst nil (ssadd en)) 
  (setq enden (entlast)) 
  (command "_break" 
    en 
    (vlax-curve-getclosestpointto en pt) 
    pt 
  ) 
  (setq ss (ssadd)) 
  (while (setq enden (entnext enden)) 
    (if (not (member (cdr (assoc 0 (entget enden))) 
       '("ATTRIB" "VERTEX" "SEQEND") 
      ) 
 ) 
      (ssadd enden ss) 
    ) 
  ) 
  (VL-CATCH-ALL-APPLY 'vl-cmdf (list "pedit" en "j" ss "" "")) 
  (sssetfirst nil (ssadd en)) 
  (sssetfirst nil nil) 
) 
 
;;;;;更新图元 
(defun gjus_ent () 
  (setq pt0 (list (car pt) (cadr pt))) 
  (setq pt2 (list (car p1) (cadr p1))) 
  (setq dat (entget en)) 
  (setq ptfrst (cons 10 pt0)) 
  (setq dat0 (reverse (member (assoc 39 dat) (reverse dat))) 
 dat1 (cdr (member (assoc 39 dat) dat)) 
 dat9 (list (last dat1)) 
 dat1 (reverse (cdr (reverse dat1))) 
 data (member ptfrst dat1) 
 datb (reverse (cdr (member ptfrst (reverse dat1)))) 
  ) 
  (setq data1 (LIST (cons 10 pt2)) 
 ptend (list ptfrst) 
 data2 (LIST (cons 40 0.0) (cons 41 0.0) (cons 42 0.0)) 
  ) 
  (setq aa (append dat0 data1 data2 data datb ptend data2 dat9)) ;排序 
  (setq dat70 (cons 70 1)  ;改为不封闭的 
 dat71 (cons 70 0) 
 aaa   (subst dat71 dat70 aa) 
  ) 
  (setq shu1 (assoc 90 aaa)  ;加多两个端点 
 shu  (cdr shu1) 
 shu2 (cons 90 (+ 2 shu)) 
 aaaa (subst shu2 shu1 aaa) 
  ) 
  (entmod aaaa) 
  (princ) 
)

有时可以画出，有时画不出来，，传了有测试图，选择不同的边有时也不能，主要是点选一条多线段，选择一点，生成一条由点开始的多线段，，，线段最后一点是这条多线段的第二个点，
我猜想，可能是增加节点后，没更新，最后DAT变量还是原来的图元资料

Andyhon · 发表于 2012-7-22 09:49:39

本帖最后由 Andyhon 于 2012-7-22 09:53 编辑

(defun c:asd ()
(command "undo" "be")
(setvar 'cmdecho 0)
(setvar 'osmode 16383)
(setq en (car (entsel "\n选择多段线:")))
(setq p1 (getpoint "\n选择切入点: "))
(setq fx (getint "\n选择方向 ([1]顺时针,[2]逆时针) <1>: "))
(if (= nil fx)
(setq fx 1)
)
(if (WCMATCH (cdr (assoc 0 (entget en))) "*POLYLINE")
(progn
(yytm)
(if (/= fx fang)
(VxRevPline obj)
)
(setq pt (vlax-curve-getClosestPointTo
(vlax-ename->vla-object en)
p1
)
)
(abhk)
(gjus_ent)
)
)
(command "undo" "e")
(princ)
)
;;; or ==================================
(defun c:asd ()
(command "undo" "be")
(setvar 'cmdecho 0)
(setvar 'osmode 16383)
(prompt "\n选择多段线:")
(if (setq en (ssget ":E:S" '((0 . "*POLYLINE"))))
(progn
(setq en (ssname en 0)
p1 (getpoint "\n选择切入点: ")
fx (getint "\n选择方向 ([1]顺时针,[2]逆时针) <1>: ")
)
(if (= nil fx)
(setq fx 1)
)
(yytm)
(if (/= fx fang)
(VxRevPline obj)
)
(setq pt (vlax-curve-getClosestPointTo
(vlax-ename->vla-object en)
p1
)
)
(abhk)
(gjus_ent)
) )
(command "undo" "e")
(princ)
)

(defun c:asd () 
  (command "undo" "be") 
  (setvar 'cmdecho 0) 
  (setvar 'osmode 16383) 
  (setq en (car (entsel "\n选择多段线:"))) 
  (setq p1 (getpoint "\n选择切入点: ")) 
  (setq fx (getint "\n选择方向 ([1]顺时针,[2]逆时针) <1>: ")) 
  (if (= nil fx) 
    (setq fx 1) 
  ) 
  (if (WCMATCH (cdr (assoc 0 (entget en))) "*POLYLINE") 
     (progn 
       (yytm) 
       (if (/= fx fang) 
         (VxRevPline obj) 
       ) 
       (setq pt (vlax-curve-getClosestPointTo 
                  (vlax-ename->vla-object en) 
                  p1 
                ) 
       ) 
       (abhk) 
       (gjus_ent) 
     ) 
  ) 
  (command "undo" "e") 
  (princ) 
) 
;;; or ================================== 
(defun c:asd () 
   (command "undo" "be") 
   (setvar 'cmdecho 0) 
   (setvar 'osmode 16383) 
    
   (prompt "\n选择多段线:") 
    
   (if (setq en (ssget ":E:S" '((0 . "*POLYLINE")))) 
     (progn 
       (setq en (ssname en 0) 
             p1 (getpoint "\n选择切入点: ") 
             fx (getint "\n选择方向 ([1]顺时针,[2]逆时针) <1>: ") 
       ) 
       
       (if (= nil fx) 
         (setq fx 1) 
       ) 
    
       (yytm) 
       
       (if (/= fx fang) 
         (VxRevPline obj) 
       ) 
       (setq pt (vlax-curve-getClosestPointTo 
                  (vlax-ename->vla-object en) 
                  p1 
                ) 
       ) 
       (abhk) 
       (gjus_ent) 
   ) )    
   (command "undo" "e") 
   (princ) 
)

依 Test.Dwg 未见您所述画不出来的情形
请个别另行指出

邹锋 · 发表于 2012-7-22 10:28:31

Andyhon 发表于 2012-7-22 09:49
依 Test.Dwg 未见您所述画不出来的情形
请个别另行指出

Andyhon · 发表于 2012-7-22 11:30:00

依样画葫芦,还是很少见错误
偶而会有,再依原点选位置执行,又不见错误了

试着这样子改
;; (vla-offset plineObj (/ len 10000))
(vla-offset plineObj 1) ;

再不行换掉判断方向的函数 yytm
站内搜吧

LLXXZZ · 发表于 2012-7-22 17:15:54

cad的线方向问题也一直让我头疼，感觉方向这么重要的东西，居然在cad显得很弱化。

邹锋 · 发表于 2012-7-22 18:41:35

Andyhon 发表于 2012-7-22 11:30
依样画葫芦,还是很少见错误
偶而会有,再依原点选位置执行,又不见错误了

调试时，发生错误我通过监视，发现，最后得出的EN中没有增加节点的“pt"这个祖玛，还是得到原来的那个第一次没改变的时候的DATA，所以排序出错了

Andyhon · 发表于 2012-7-22 20:32:02

(VL-CATCH-ALL-APPLY 'vl-cmdf (list "pedit" en "j" ss "" ""))
(setq pt (osnap pt "end")) ; 加这句试试能改善否

Andyhon · 发表于 2012-7-23 07:57:04

(setq pt (vlax-curve-getClosestPointTo
      (vlax-ename->vla-object en)
      p1
   )
)
.
.
.
(command "_break"
   en
   (vlax-curve-getclosestpointto en pt)
   pt
)
.
.
.
(VL-CATCH-ALL-APPLY 'vl-cmdf (list "pedit" en "j" ss "" ""))
形成了新的点表
其节点(pt断点) 理论上应同于 Pt
但实务上有时却不被 AutoCAD 认可
(setq pt (osnap pt "end"))  ; 作用在重归位 ==> 取自新的点表位置

账号		自动登录	找回密码
密码			注册

有时错有时可以运行，神马问题？

本帖子中包含更多资源

相关帖子

点评

本帖子中包含更多资源

点评

评分

点评