麻烦大粗帮看下这两个程序那错了有时能用，有时却不能用。请多多指教。不胜感激！
麻烦大粗帮看下这两个程序那错了有时能用，有时却不能用。请多多指教。不胜感激！;;;;;;;多重剪切
(defun c:trim1()
(setq i 0)
(repeat (sslength seltrim)
(setq t (entget (ssname seltrim i)))
(setq i (+ 1 i))
(setq p1x (cadr (assoc 10 t)) p1y (caddr (assoc 10 t)) )
(setq p2x (cadr (assoc 11 t)) p2y (caddr (assoc 11 t)) )
(setq p1 (list p1x p1y) p2 (list p2x p2y) )
(setq j 0 k 0 )
(setq inter1 nil inter2 nil inter3 nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(repeat (sslength seltrim)
(setq t1 (entget (ssname seltrim j)))
(setq j (1+ j))
(progn
(SETQ P3X (cadr (assoc 10 t1)))
(setq p3y (caddr (assoc 10 t1)))
(setq p4x (cadr (assoc 11 t1)))
(setq p4y (caddr (assoc 11 t1)))
(setq p3 (list p3x p3y))
(setq p4 (list p4x p4y))
(setq Pinter (inters P1 P2 P3 P4 ))
(IF (/= pinter nil) (setq k (+ k 1)) )
(IF (and (= K 1) (/= PINTER NIL) ) (SETQ INTER1 PINTER) )
(if (and (= k 2) (/= pinter nil) ) (SETQ INTER2 PINTER) )
(if (= k 2) (progn(SETQ DIST1 (DISTANCE INTER1 P1) DIST2 (DISTANCE INTER2 P1) )
(if (> dist1 dist2) (setq point inter1 inter1 inter2 inter2 point) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and (> k 2) (/= pinter nil) )
(progn
(SETQ INTER3 PINTER)
(SETQ DIST1 (DISTANCE INTER1 P1) DIST2 (DISTANCE INTER2 P2) )
(SETQ DIST3 (DISTANCE INTER3 P1))
(SETQ DIST4 (DISTANCE INTER3 P2))
(if (> dist1 dist3) (setq inter1 inter3) )
(if (> dist2 dist4) (setq inter2 inter3) )
(setq pinter nil)
(setq dist1 nil dist2 nil dist3 nil dist4 nil)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (/= (and inter1 inter2) nil)
(progn
(setq mp1 (list 10 (car inter1) (cadr inter1) ) )
(setq t (subst mp1 (assoc 10 t) t))
(setq mp2 (list 11 (car inter2) (cadr inter2) ) )
(setq t (subst mp2 (assoc 11 t) t))
(entmod t)
)
)
)
)
;;;
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;子程序trim2开始;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:trim2()
(setvar "osmode" 0)
(setq point1x (car point1))
(setq point1y (cadr point1))
(setq point3x (car point3))
(setq point3y (cadr point3))
(setq point2 (list point1x point3y))
(setq point4 (list point3x point1y))
;(PRINT)
;(PRINC "POINT1=")(PRIN1 POINT1)
;(PRINT)
;(PRINC "POINT2=")(PRIN1 POINT2)
;(PRINT)
;(PRINC "POINT3=")(PRIN1 POINT3)
;(PRINT)
;(PRINC "POINT4=")(PRIN1 POINT4)
(IF (OR(=POINT1X POINT3X)(=POINT1Y POINT3Y))
(PROGN
(command "trim" SELTRIM "" )
(COMMAND "f"point1 POINT3 "" "")
(command "trim" SELTRIM "" )
(COMMAND "f"point3 POINT1 "" "")
)
(PROGN
(command "trim" SELTRIM "" )
(COMMAND "f"point1 point2 POINT3 POINT4 "" "")
(command "trim" SELTRIM "" )
(COMMAND "f"point4 point3 point2 point1 POINT4 "" "")
)
)
(setq tr 10)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;子程序trim2完成;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;以下是主程序
(DEFUN C:TR ()
(start00)
(setvar "osmode" 0)
(SETQ EDGEMODEED (GETVAR "EDGEMODE"))
(SETVAR "EDGEMODE" 1)
(setq tr nil)
(prompt "\nSelect cutting edges:")
(setq seltrim (ssget))
(prompt "\nSelect object to trim")
(setq point1 (getpoint "\nEnter the 1st point:"))
(if (and seltrim (null point1 ))(c:trim1))
;;;;;;;;
(IF (/= POINT1 NIL)
(PROGN
(setq kit nil)
(setq kit 1)
(while (< kit 5)
(setq point3 (getcorner point1 "\nEnter the 2st point:"))
(if (null point3) (princ "无效的点!请重输:")(setq kit 6)
);if
);while
(setq kit nil)
(setq seltrimed (ssget "c" point1point3 ))
(IF (and (= TR NIL) (/= seltrimed nil) ) (C:TRIM2) )
(setq xxxx 0)
(if (= tr 10)
(while (< xxxx 5)
(prompt "\nSelect object to trim")
(setq point1 (getpoint "\nEnter the 1st point:"))
(if (/= point1 nil)
(progn
(setq kit nil)
(setq kit 1)
(while (< kit 5)
(setq point3 (getcorner point1 "\nEnter the 2st point:"))
(if (null point3) (princ "无效的点!请重输:")(setq kit 6)
);if
);while
(setq kit nil)
(setq seltrimed (ssget "c" point1point3 ))
(if (/= seltrimed nil) (c:trim2) )
)
(setq xxxx 10)
)
)
)
)
)
;;;;;;;
(COMMAND "UCS" "P" )
(setvar "osmode" 15359)
(SETVAR "EDGEMODE" EDGEMODEED)
(setq tr nil)
(command "_.UNDO" "_E")
(setvar "osmode" 15359)
(PRINC )
)
;;;
;;;;;;;;;
;;;;;;;;;
;;;;;;;;;;;
;;;;;;;快速制块程序
(defun c:kk ()
(start00)
(setvar "osmode" 0)
(setq sel (ssget))
(setq poin (cdr (assoc 10 (entget (ssname sel0)))) )
(setq qqqq (cadr (grread)))
(setq qqqqy (itoa (fix (abs (* 10000 (cadr qqqq))))))
(setq qqqqx (itoa (fix (abs (* 10000 (car qqqq))))))
(setq qqqq (strcat qqqqx qqqqy))
(setq ww qqqq)
(setq bqqqq (strcat "b" qqqq))
(if (null qqqq) (setq qqqq 1))
(setq k 1)
(while (< k 5)
(if (tblsearch "block" bqqqq)
(progn
(setq qqqq (+ 1 qqqq))
(setq bqqqq (strcat "b" qqqq))
);progn
(setq k 10));if
);while
;(ssget)
;(command "chprop" "p" "" "c" "byblock" "")
(command "block" bqqqq poin "p" "")
;(command "color" "byblock" )
(command "insert" bqqqq poin "" "" "")
;(command "color" "bylayer")
;(command "chprop" "l" "" "c" "byblock" "")
(setvar "osmode" osnap1)
(setq k nil)
(setq qqqq nil poin nil qqqqx nil qqqqy nil bqqqq nil)
(command "_.UNDO" "_E")
(princ )
)
;;;;;;;多重延伸
(defun exarc (arc / edba ctr sang eang radi sp ep)
(setq edba (entget arc))
(setq ctr (cdr (assoc 10 edba)))
(setq sang (cdr (assoc 50 edba)))
(setq eang (cdr (assoc 51 edba)))
(setq radi (cdr (assoc 40 edba)))
(setq sp (polar ctr sang radi))(setq ep (polar ctr eang radi))
(if (> (distance esp sp)(distance esp ep)) (setq sp ep))
(command "extend" edge "" sp ""))
(defun exline (line / sp ep inti into)
(setq sp (findend1 line))(setq ep (findend2 line))
(setq into (inters sp ep esp eep nil))
(setq inti (inters sp ep esp eep t))
(if (and (= inti nil) (/= into nil))
(command "change" line "" into)))
(defun ckandex (sset / ln i ent typ)
(setq ln (sslength sset))
(setq i 0)(setvar "cmdecho" 0)
(while (< i ln)
(setq ent (ssname sset i))
(setq typ (cdr (assoc 0 (entget ent))));get the object type
(cond ((= typ "LINE") (exline ent));extend it according to its type
((= typ "ARC") (exarc ent)))
(setq i (1+ i))))
(defun findend1 (l)
(cdr (assoc 10 (entget l))))
(defun findend2 (l)
(cdr (assoc 11 (entget l))))
(defun getline (prom / ck line otype)
(setq ck "n")
(while (= ck "n")
(terpri)(setq temp (entsel prom))
(if (= temp nil)
(prompt "\n没有选到任何物件请再选一次...")
(progn (setq line temp)
(setq line (nth 0 line))
(setq otype (cdr (assoc 0 (entget line))))
(if (= otype "LINE")
(setq ck "y")
(prompt "\n这不是线，请再选一次...")))))
(eval line))
(defun C:EX (/ edge esp eep p1 p2 exts)
(setq edge (getline (strcat "\n" "请点取边界线 !")))
(setq esp (findend1 edge))
(setq eep (findend2 edge))
(prompt "\n请点取二点开框来选取要延伸的图形 ....")
(setq p1 (getpoint "\n请输入选取框的第一点 : "))
(setq p2 (getcorner p1 "\n请输入选取框的第二点: "))
(setq exts (ssget "c" p1 p2))
(ckandex exts))
;;;
;;;;;;;;;
;;;;;;;;;
剪切和延伸,楼主要达到什么目的，不表达别人怎么帮忙？ xiaxiang 发表于 2011-10-28 13:31 static/image/common/back.gif
剪切和延伸,楼主要达到什么目的，不表达别人怎么帮忙？
就是多重剪切和多重延伸。可以同时剪切或延伸多条线段。 xiaxiang 发表于 2011-10-28 13:31 static/image/common/back.gif
剪切和延伸,楼主要达到什么目的，不表达别人怎么帮忙？
请多指教，谢谢。 (start00)这个函数没有提供？屏蔽之
快速制块程序中加入(setq osnap1 (getvar "osmode"))这一句
别的没看出什么来
还有，时好时不好，故障是什么，方便别人测试哦 xiaxiang 发表于 2011-10-28 14:23 static/image/common/back.gif
(start00)这个函数没有提供？屏蔽之
快速制块程序中加入(setq osnap1 (getvar "osmode"))这一句
别的没 ...
谢谢，可否帮小弟修改下。 木有人啊 试了一下，多重剪切将这两句屏蔽一下即可
;;(start00)
;;(COMMAND "UCS" "P")
页:
[1]
2