Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/12/2018 in all areas

  1. ronjonp
    Not very pretty but this may give you a start. It currently inserts text. (defun c:foo (/ a aa b c d e l ll n p pa) ;; RJP » 2018-10-12 ;; Divides a polyline into segments then divides another distance at each of those ;; points while incrementing a number by 1. Polyline direction will dictate what ;; side the numbering starts on. Happy Friday! (cond ((and (setq e (car (entsel "\nPick your centerline: "))) (= "LWPOLYLINE" (cdr (assoc 0 (entget e)))) ;;; (setq a (getint "\nEnter number of segments to place on centerline: ")) ;;; (setq b (getdist "\nEnter length for each segment: ")) ;;; (setq c (getint "\nEnter quantity of numbers to place on each segment: ")) ;; Testing numbers (setq a 50 b 25. c 5 ) ) (setq d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) (setq n 0) (repeat a (cond ((setq p (vlax-curve-getpointatdist e n)) (setq aa (angle '(0 0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)))) (setq n (+ n (/ d (1- a)))) (setq p (polar p (setq pa (+ aa (/ pi 2.))) (/ b 2.))) (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (+ pi pa) b)) '(8 . "line"))) (setq l nil) (repeat c (setq l (cons p l)) (setq p (polar p (+ pi pa) (/ b (1- c))))) (setq ll (cons (reverse l) ll)) ) ) ) (setq n 0) (setq ll (reverse ll)) (while (car ll) (foreach p (mapcar 'car ll) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(8 . "text") '(100 . "AcDbText") (cons 10 p) (cons 40 (/ (/ b (1- c)) 2.)) (cons 1 (itoa (setq n (1+ n)))) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) '(71 . 0) '(72 . 1) (cons 11 p) '(100 . "AcDbText") '(73 . 2) ) ) ) (setq ll (mapcar 'cdr ll)) ) ) ) (princ) )
    1 point
  2. Cad64
    One thing you have to realize is that after you run WBLOCK and generate a new clean file, if you copy anything from another problematic drawing and paste it into your new file, you have now infected your clean file with all the same junk again. Try running WBLOCK on both files. Then do the copy and paste and see if you still have issues.
    1 point
  3. ronjonp
    Post a sample of your drawing, if you need code to cleanup these existing plans I have an idea.
    1 point
  4. Grrr
    [BBC] 2 <HTML> Hey guys, I had fun today, while assembling this: (defun C:BBC2HTML nil (BBC2HTML (getfiled "Specify LISP file" (strcat (getenv "userprofile") "\\Desktop\\TestFolder\\") "bbc;lsp;txt" 16)) (princ) ); defun C:BBC2HTML ; https://www.cadtutor.net/forum/topic/66065-new-forum-code-tags/ ; <!-- BBC 2 HTML, assembled by Grrr, credits to Lee Mac --> ; Substitutes [color="???"][/color] [b][i][u] BBC tags with html ones ; and then it creates an unique .html file and opens it ; NOTE: one still has to be careful and must check where he did used square brackets for his lisp code [] ! - are usually used within ssget/wcmatch patterns or regex ; 'src' - filepath that contains a BBC-formatted code (defun BBC2HTML ( src / des rgx rtn str tmp r ) (if (and (eq 'STR (type src)) (setq des (open src "r"))) (progn (while (setq str (read-line des)) (setq tmp (vl-list* "\n" str tmp))) (close des) (cond ( (null (setq rgx (vlax-create-object "vbscript.regexp"))) (prompt "\nUnable to interface with RegEx object.") ) ( (vl-catch-all-error-p (setq rtn (vl-catch-all-apply (function (lambda ( ) (foreach x '(Global Multiline Ignorecase) (vlax-put-property rgx x acTrue) ); foreach (setq tmp (apply 'strcat (reverse tmp))) (foreach x '( ("<" . "&lt") (">" . "&gt") ("\\[\\s*\/*\\s*(color)\\s*\\]" . "<\/font>") ("\\[\\s*(color)\\s*=\\s*\"" . "<font color=\"") ("\"\\s*\\]" . "\">") ("\\[\\s*b\\s*\\]" . "<b>") ("\\[\\s*i\\s*\\]" . "<i>") ("\\[\\s*u\\s*\\]" . "<u>") ("\\[\\s*\/\\s*b\\s*\\]" . "<\/b>") ("\\[\\s*\/\\s*i\\s*\\]" . "<\/i>") ("\\[\\s*\/\\s*u\\s*\\]" . "<\/u>") ("\\[\\s*\/*(code)\\s*\\]" . "")("\\[\\s*(color)\\s*=\\s*" . "<font color=") ("\\s*\\]" . ">") ; for David Bethel's lsp2bbc ) (vlax-put-property rgx 'Pattern (car x)) (setq tmp (vlax-invoke-method rgx 'Replace tmp (cdr x))) ); foreach tmp ); lambda ) ) ) ) (prompt (strcat "\nError: " (vl-catch-all-error-message rtn))) ) (rtn (princ (setq rtn (strcat "\n<!-- Open this resulted 'html' file with IE/Chrome/Mozilla -->" "\n<!-- BBC 2 HTML, assembled by Grrr, credits to Lee Mac -->" "\n<html>" "\n<head><title>" (cadr (fnsplitl src)) "</title></head>" "\n<body>" "\n<div style=\"white-space: pre;\">" rtn "\n</div>" "\n</body>" "\n</html>" ); strcat ); setq rtn (setq des (open (setq tmp ; (vl-filename-mktemp ; << not required, (I didn't knew this lol) ( ; unique filename sub (lambda (s / i tmp) (setq i 0) (while (findfile (setq tmp (strcat s "_" (itoa i) ".html"))) (setq i (1+ i))) tmp ); lambda (apply (function (lambda (a b c) (vl-string-translate "/" "\\" (strcat a b)))) (fnsplitl src)) ) ; ); vl-filename-mktemp ); setq tmp "W" ); open ); setq des ); princ (close des) (princ (strcat "\nTemporary html file created at \"" tmp "\", don't forget to erase it.")) ( (lambda ( fpath / shell ) ; ShellOpen (if fpath (vl-catch-all-apply (function (lambda nil (setq shell (vlax-get-or-create-object "Shell.Application")) (vlax-invoke-method shell 'Open fpath) ) ) ) ) (vl-catch-all-apply 'vlax-release-object (list shell)) ); lambda tmp ) (setq r rtn) ); rtn ) ) (princ "\nUnable to read the file.") ) (and (eq 'VLA-OBJECT (type rgx)) (vl-catch-all-apply (function vlax-release-object) (list rgx))) (princ) ); defun BBC2HTML Basically it will attempt to replace the bold/underline/italic/color BBC tags with HTML ones (I'm not so familiar with bbc formatting, so I couldn't figure out any other tags). Then it will create an unique .html file and open it with your browser to display the colored code. Demo: I tested it with • David Bethel's LSP2BBC, • Lee Mac's LM:Lispstyler (BBC conversion), • aswell some manual BBC modifications that you saw in the above posts and it seems to work fine! Although still be careful with your square brackets [ ] in your lisp code! Hm, now I see that the admins work on that issue! +=
    1 point
×
×
  • Create New...