Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/26/2022 in all areas

  1. When you look carefully at "CABEÇALHO" the Ç is an extended character, ie a alt+num so ZWcad is trying to display with possibly a font that does not have Ç as a character. Bricscad was OK. If there is a way of defining the font to be used for display in ZWcad then it may display correct.
    3 points
  2. Use inkskape (free) or lightburn has a 30 day demo. -edit might need a little bit of clean up but faster then tracing. highfive.dwg
    2 points
  3. Thank you for kindly reply. I mistake copy and paste to my own lisp. missing the definition of findplotarea. So I check original code and find that and copy and paste to my own lisp. it is work. Thank you again.
    2 points
  4. All fixed and much cleaner and removed numerous lacks... My recommendation is to work with this code instead of my last one... (defun c:pts_along_pipe_trees_by_length-new ( / *error* pea cad doc reversepoly preprocess process bp dd ch c ell xll ) ; ell xll - lexical globals (vl-load-com) (defun *error* ( m ) (if pea (setvar 'peditaccept pea) ) (if (and doc (= 8 (logand 8 (getvar 'undoctl))) ) (vla-endundomark doc) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun reversepoly ( curve / rlw r3dp rhpl ) (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 ) ;; by ElpanovEvgeniy (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE") (progn (foreach a1 e (cond ( (= (car a1) 10) (setq x2 (cons a1 x2)) ) ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) ) ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) ) ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) ) ( (= (car a1) 210) (setq x6 (cons a1 x6)) ) ( t (setq x1 (cons a1 x1)) ) ) ) (entmod (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons (function list) (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) ) ) ) ) x6 ) ) ) (entupd lw) ) ) ) ;; Reverse 3DPOLYLINE - Marko Ribar, d.i.a. (defun r3dp ( 3dp / r3dppol typ ) (defun r3dppol ( 3dp / v p pl sfa var ) (setq v 3dp) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq p (cdr (assoc 10 (entget v))) pl (cons p pl)) ) (setq pl (apply (function append) pl) sfa (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pl))))) (vlax-safearray-fill sfa pl) (setq var (vlax-make-variant sfa)) (vla-put-coordinates (vlax-ename->vla-object 3dp) var) (entupd 3dp) ) (setq typ (vla-get-type (vlax-ename->vla-object 3dp))) (vla-put-type (vlax-ename->vla-object 3dp) acsimplepoly) (r3dppol 3dp) (if typ (vla-put-type (vlax-ename->vla-object 3dp) typ)) (entupd 3dp) ) ;; Reverse old heavy 2d POLYLINE - Marko Ribar, d.i.a. - sub functions by Roy at Theswamp.org (defun rhpl ( hpl / KGA_List_Divide_3 KGA_List_IndexSeqMakeLength KGA_Geom_PolylineReverse ) (defun KGA_List_Divide_3 ( lst / ret ) (repeat (/ (length lst) 3) (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret) lst (cdddr lst)) ) (reverse ret) ) ; Make a zero based list of integers. (defun KGA_List_IndexSeqMakeLength ( len / ret ) (repeat (rem len 4) (setq ret (cons (setq len (1- len)) ret)) ) (repeat (/ len 4) (setq ret (vl-list* (- len 4) (- len 3) (- len 2) (- len 1) ret) len (- len 4)) ) ret ) ; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline". (defun KGA_Geom_PolylineReverse ( obj / typ bulgeLst idxLst ptLst widLst conWid v vx ) (setq typ (vla-get-type obj)) (vla-put-type obj acsimplepoly) (setq ptLst (KGA_List_Divide_3 (vlax-get obj 'coordinates)) idxLst (KGA_List_IndexSeqMakeLength (1+ (length ptLst))) v (vlax-vla-object->ename obj)) (while (= (cdr (assoc 0 (setq vx (entget (setq v (entnext v)))))) "VERTEX") (setq widLst (cons (list (cdr (assoc 40 vx)) (cdr (assoc 41 vx))) widLst) bulgeLst (cons (cdr (assoc 42 vx)) bulgeLst)) ) (if (vl-catch-all-error-p (setq conWid (vl-catch-all-apply (function vla-get-constantwidth) (list obj)))) (mapcar (function (lambda ( idx pt bulge widSub ) (vla-put-coordinate obj idx (vlax-3d-point pt)) (vla-setbulge obj idx (- bulge)) (vla-setwidth obj idx (cadr widSub) (car widSub)) )) idxLst (reverse ptLst) (append (cdr bulgeLst) (list (car bulgeLst))) (append (cdr widLst) (list (car widLst))) ) (progn (mapcar (function (lambda ( idx pt bulge widSub ) (vla-put-coordinate obj idx (vlax-3d-point pt)) (vla-setbulge obj idx (- bulge)) )) idxLst (reverse ptLst) (append (cdr bulgeLst) (list (car bulgeLst))) ) (vla-put-constantwidth obj conWid) ) ) (if typ (vla-put-type obj typ)) ) (KGA_Geom_PolylineReverse (vlax-ename->vla-object hpl)) (entupd hpl) ) (cond ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDb2dPolyline") (rhpl curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDb3dPolyline") (r3dp curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbPolyline") (rlw curve) ) ) ) (defun preprocess ( e / uniquevbl ss ex i b vbl sa coords ) (defun uniquevbl ( l ) (if l (cons (car l) (uniquevbl (vl-remove-if (function (lambda ( x ) (equal (caar l) (car x) 1e-6) )) (cdr l) ) ) ) ) ) (if (or e (setq ss (ssget "_A" (list (cons 0 "*POLYLINE"))))) (foreach pl (if e (list e) (vl-remove (function listp) (mapcar (function cadr) (ssnamex ss)))) (setq ex (entget pl)) (if (and (not e) (or (= (cdr (assoc 90 ex)) 1) (and (= (cdr (assoc 90 ex)) 2) (equal (cdr (assoc 10 ex)) (cdr (assoc 10 (reverse ex))) 1e-6) ) ) ) (entdel pl) ) (if (not (vlax-erased-p pl)) (progn (setq vbl nil) (setq i (1+ (fix (+ 0.1 (vlax-curve-getendparam pl))))) (while (<= 0 (setq i (1- i))) (setq vbl (cons (list (vlax-curve-getpointatparam pl (float i)) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object pl) i))))) b)) vbl)) ) (setq vbl (uniquevbl vbl)) (if (= (cdr (assoc 0 ex)) "LWPOLYLINE") (progn (setq vbl (mapcar (function (lambda ( x ) (list (trans (car x) 0 (cdr (assoc 210 ex))) (cadr x)))) vbl)) (setq ex (subst (cons 90 (length vbl)) (assoc 90 ex) ex)) (setq ex (append (vl-remove-if (function (lambda ( x ) (vl-position (car x) (list 10 40 41 42 91 210)) )) ex ) (apply (function append) (mapcar (function (lambda ( x ) (list (cons 10 (car x)) (cons 40 0.0) (cons 41 0.0) (cons 42 (cadr x)) (cons 91 0.0) ) )) vbl ) ) (list (assoc 210 ex)) ) ) (entupd (cdr (assoc -1 (entmod ex)))) ) (progn (setq sa (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length (setq coords (apply (function append) (mapcar (function car) vbl)))))))) (vla-put-coordinates (vlax-ename->vla-object pl) (vlax-make-variant (vlax-safearray-fill sa coords))) ) ) ) ) ) ) ) (defun process ( dd qt pt / proclst makepoly processlst ss i el e d len f par lst pp ) (defun proclst ( e dd qt pt / pp par ddd ) (if (and (setq par (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans qt 1 0)))))) (setq pp (vlax-curve-getpointatparam e par)) ) (progn (setq ddd (- dd (vlax-curve-getdistatpoint e pp))) (if (> ddd 0) (setq processlst (cons (list ddd qt pt) processlst)) ) ) ) ) (defun makepoly ( e p c / polyprocess s eel el pl1 pl2 pl3 vl i qtt ) (defun polyprocess ( e q c / f ln ep i pbl par b arcll arclx a ex ) (setq ln (vlax-curve-getdistatparam e (setq ep (vlax-curve-getendparam e)))) (repeat (setq i (1+ (fix (+ 0.1 ep)))) (setq pbl (cons (list (vlax-curve-getpointatparam e (float (setq i (1- i)))) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object e) i))))) b) ) pbl ) ) ) (setq par (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e q))) (if (equal par ep 1e-6) (progn (reversepoly e) (entupd e) (setq f t) ) ) (setq pbl nil) (repeat (setq i (1+ (fix (+ 0.1 ep)))) (setq pbl (cons (list (vlax-curve-getpointatparam e (float (setq i (1- i)))) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object e) i))))) b) ) pbl ) ) ) (setq par (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e q))) (if (and par pbl) (progn (if (and (vlax-curve-getpointatparam e (float (fix (1+ par)))) (setq b (cadr (nth (fix par) pbl))) ) (progn (setq arcll (- (vlax-curve-getdistatparam e (float (fix (1+ par)))) (vlax-curve-getdistatparam e (float (fix par))) ) ) (setq arclx (- (vlax-curve-getdistatparam e par) (vlax-curve-getdistatparam e (float (fix par))) ) ) (setq a (* 4.0 (atan b))) (setq b (/ (sin (/ (* (/ a arcll) arclx) 4.0)) (cos (/ (* (/ a arcll) arclx) 4.0)))) ) ) (setq pbl (reverse (member (nth (fix par) pbl) (reverse pbl)))) (setq pbl (append (subst (list (car (last pbl)) b) (last pbl) pbl) (list (list q nil)))) (setq ex (entget e)) (if f (progn (reversepoly e) (entupd e) ) ) (if (vl-some (function numberp) (mapcar (function cadr) pbl)) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pbl)) (cons 70 (* 128 (getvar 'plinegen))) (assoc 38 ex) ) (apply (function append) (mapcar (function (lambda ( x ) (list (cons 10 (trans (car x) 0 (cdr (assoc 210 ex)))) (cons 40 0.0) (cons 41 0.0) (cons 42 (if (cadr x) (cadr x) 0.0)) (cons 91 0.0) ) )) pbl ) ) (list (assoc 210 ex) (cons 62 c) ) ) ) (progn (vl-cmdf "_.3DPOLY") (foreach pb pbl (vl-cmdf "_non" (trans (car pb) 0 1)) ) (vl-cmdf "") (entupd (cdr (assoc -1 (entmod (if (assoc 62 (setq ex (entget (entlast)))) (subst (cons 62 c) (assoc 62 ex) ex) (append ex (list (cons 62 c))) ) ) ) ) ) ) ) ) ) ) (setq xll (cons (setq pl1 (polyprocess e p c)) xll)) (setq qtt (trans (vlax-curve-getpointatparam pl1 0.0) 0 1)) (if (and (not (equal (trans qtt 1 0) (trans bp 1 0) 1e-6)) (setq s (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) qtt) (mapcar (function +) (list 1e-3 1e-3) qtt) (list (cons 0 "*POLYLINE")))) (> (sslength s) 0) ) (progn (if (ssmemb e s) (ssdel e s) ) (if (ssmemb pl1 s) (ssdel pl1 s) ) (foreach x xll (if (and s (ssmemb x s)) (ssdel x s) ) ) (if (and s (> (sslength s) 0)) (setq eel (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))) ) ) ) (foreach ee eel (setq f nil) (setq pl3 (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object pl1)))) (if (< (vlax-curve-getparamatpoint ee (trans bp 1 0)) (vlax-curve-getparamatpoint ee (trans qtt 1 0))) (setq pl2 (polyprocess ee qtt c)) (progn (reversepoly ee) (entupd ee) (setq pl2 (polyprocess ee qtt c)) (setq f t) ) ) (if f (progn (reversepoly ee) (entupd ee) ) ) (setq el (entlast)) (if (and pl2 pl3) (progn ;| (vl-cmdf "_.PEDIT" "_M" (ssadd pl2 (ssadd pl3)) "" "_J") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) |; (vl-cmdf "_.JOIN" (ssadd pl2 (ssadd pl3)) "") (if (not (eq el (entlast))) (setq el (entlast)) (setq el (if pl2 pl2 pl3)) ) (preprocess el) (if (vl-position pl1 xll) (setq xll (subst el pl1 xll)) (setq xll (cons el xll)) ) ) ) ) (if (and eel pl1 (not (vlax-erased-p pl1))) (entdel pl1) ) ) (if (and (setq ss (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) (setq qt (osnap qt "_nea"))) (mapcar (function +) (list 1e-3 1e-3) qt) (list (cons 0 "*POLYLINE")))) (progn (foreach x (append xll ell) (if (ssmemb x ss) (ssdel x ss) ) ) (and ss (> (sslength ss) 0)) ) ) (progn (repeat (setq i (sslength ss)) (if (and (not (vl-position (setq e (ssname ss (setq i (1- i)))) ell)) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list e)))) ) (setq el (cons (list e pt) el)) ) ) (if el (progn (setq ell (append (vl-remove-if (function (lambda ( x ) (vl-position x xll))) (mapcar (function car) el)) ell)) (foreach ep el (setq f nil lst nil) (setq e (car ep) pt (cadr ep)) (setq d (vlax-curve-getdistatpoint e (trans qt 1 0))) (setq len (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) (if (equal d len 1e-6) (progn (reversepoly e) (entupd e) (setq f t) ) ) (setq d (vlax-curve-getdistatpoint e (trans qt 1 0))) (repeat (setq par (fix (+ 0.1 (vlax-curve-getendparam e)))) (setq lst (cons (trans (vlax-curve-getpointatparam e (float (1+ (fix (setq par (1- par)))))) 0 1) lst ) ) ) (foreach p lst (proclst e dd p pt) ) (cond ( (and (zerop d) (= (cdr (assoc 90 (entget e))) 2) (vlax-curve-getpointatdist e dd) ) (if (and e (not (vlax-erased-p e)) (setq pp (vlax-curve-getpointatdist e dd))) (progn (entmake (list (cons 0 "POINT") (cons 10 pp))) (if (= ch "Yes") (makepoly e pp c)) ) ) ) ( (<= 0.0 (+ d dd) len) (if (and e (not (vlax-erased-p e)) (setq pp (vlax-curve-getpointatdist e (+ d dd)))) (progn (entmake (list (cons 0 "POINT") (cons 10 pp))) (if (= ch "Yes") (makepoly e pp c)) ) ) ) ) (if f (progn (reversepoly e) (entupd e) ) ) ) ) ) (foreach lst processlst (process (car lst) (cadr lst) (caddr lst)) ) ) ) ) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1) (if (and (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object)))) (= 8 (logand 8 (getvar 'undoctl))) ) (vla-endundomark doc) ) (if doc (vla-startundomark doc) ) (if (and (setq bp (getpoint "\nPick or specify main base point : ")) (not (initget 6)) (setq dd (cond ( (not (setq dd (getdist bp "\nPick or specify length from base point for spread around <1.0> : "))) 1.0 ) ( t dd ))) (not (initget "Yes No")) (setq ch (cond ( (not (setq ch (getkword "\nDo you want to overmake new polylines up to resulting points [Yes / No] <Yes> : "))) "Yes" ) ( t ch ))) (if (= ch "Yes") (progn (initget 6) (setq c (cond ( (not (setq c (getint "\nSpecify color for new polylines <3> : "))) 3 ) ( t c ))) ) t ) ) (progn (if cad (vla-zoomextents cad) ) (preprocess nil) (process dd bp bp) ) ) (*error* nil) ) Regards, M.R. HTH.
    2 points
  5. *Should* is questionable. Just another way to go about things.
    1 point
  6. Hi Steve! It's an alternative. However, I don't just read the "block name" property, but I also read values that the user has entered into attribute fields. And as the language is Portuguese, even if I change the block name, the user can type texts in the attribute fields that contain these characters. Anyway, thanks for the suggestion.
    1 point
  7. Have a lisp that pulls names from existing text. it would error if it contained any windows illegal characters. so i have it automatically check and replace with this line. (setq blkname (vl-string-translate "<>:\"/\\|?*" " _ " blkname)) ;replace ileagel characters with space and / with _ If you can't change the default font in ZWcad like BIGAL said. maybe list all the illegal characters and translate them to something else/similar that can be dispalyed.
    1 point
  8. I know that this is cheating but can you call the block something different, without the extended characters? A quick fix but maybe not the best fix
    1 point
  9. Nice, thanks Mhupp. Quite a lot in that, but will tidy up nicely I think for what I do. Will try to remember to post mine in here early next week
    1 point
  10. I've corrected my last version and it should be fully operational and ready for usage... If you still find some lacks, please report... M.R.
    1 point
  11. Is it possible that the UCS is not vertical? That might explain why the duplicates are offset like that. I assume you changed the colors of the extra lines for emphasis, so you can't just select them based on color. BigAl is right, the only sure solution is to prevent the problem. The glitch is upstream from you, right? You didn't convert something sent to you.
    1 point
  12. (defun c:saveall ( / ) (vl-load-com) (vlax-for OpenDwgs (vla-get-documents (vlax-get-acad-object)) (vla-save OpenDwgs) );; vlax-for (princ) )
    1 point
  13. Hmm compare area of plines so get 2, get lower left point of both. delete say lowest. Re dims same thing get length so get 2 again compare say text point and delete lowest. A tricky bit of code. How many of these are you getting ? Best solution go back to who is making with a 2x4, should solve the problem.
    1 point
  14. I am not sure of the commands for ZWCAD, AutoCAD does have "saveall" command in the express tools ZWCAD should be able to run this I think: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/zoom-extents-all-opened-drawings-lisp-routine/td-p/5402517 Google reckons that this zooms all and saves all the open drawings, take out the zoom function and away you go. I haven't tried this yet but might in a moment
    1 point
×
×
  • Create New...